Excel VBA: Get list of data in another column

Question

I'm currently creating an automation to automate some task. Basically, I have this data:

My goal is to transfer all of the account in another sheet (Sheet2).

Problem: I can't seem to display the bank name along with the account number under them. As the bank name is always blank.

The bank and account number can grow, in this case I wanted it to be dynamic. However, when I tried to add an account number in the last bank it stopped pasting the additional account number. Also if the code can also be improved?

To summarize, I wanted to get the list of account number under a bank. After getting it, I will be doing some other tasks before it loop to another bank and account number. But I haven't yet included in the code below:

Sub test1()

Dim lRow As Long

lRow = Cells(Rows.Count, 1).End(xlUp).Row

Range("B2").Select

For i = 2 To lRow

    ActiveSheet.Cells(i, 2).Select

    If ActiveCell.Offset(1, -1).Value = "" Then

            ActiveCell.Copy
            Sheets("Sheet2").Select
            ActiveSheet.Paste
            ActiveCell.Offset(1.1).Select
            Sheets("Sheet1").Select


    Else
        ActiveCell.Copy
        Sheets("Sheet2").Select
        ActiveSheet.Paste
        ActiveCell.Offset(1.1).Select
        Sheets("Sheet1").Select

        'I need to to insert other steps here
        MsgBox "New Bank. Need to do other steps"

    End If

Next i

End Sub

Desired Result:

Answer 1

You can try code below. Update sheet references where needed!

Public Sub CopyToSecondSheet()
    Dim wksSource As Worksheet: Set wksSource = ThisWorkbook.Sheets("Sheet1")
    Dim wksDestin As Worksheet: Set wksDestin = ThisWorkbook.Sheets("Sheet2")
    Dim i As Long
    Dim strBankName as String
    Application.ScreenUpdating = False
    wksDestin.Range("A1:A" & wksDestin.Range("A" & wksDestin.Rows.Count).End(xlUp).Row).Delete xlUp
    For i = 2 To wksSource.Range("B" & wksSource.Rows.Count).End(xlUp).Row
        If Len(wksSource.Range("A" & i).Value) > 0 Then
            If Len(strBankName) > 0 Then Msgbox "Finished copying records for : " & strBankName, vbOKOnly
            strBankName = wksSource.Range("A" & i).Value
            wksSource.Range("A" & i).Copy wksDestin.Range("A" & wksDestin.Rows.Count).End(xlUp).Offset(1, 0)
        End If
        wksSource.Range("B" & i).Copy wksDestin.Range("A" & wksDestin.Rows.Count).End(xlUp).Offset(1, 0)
    Next
    Msgbox "Update completed!", vbInformation
    Application.ScreenUpdating = True
End Sub