Excel VBA：獲取另一列中的數據列表

Question

我目前正在創建一個自動化來自動化一些任務。 基本上，我有這個數據：

我的目標是將所有帳戶轉移到另一個工作表（Sheet2）中。

問題：我似乎無法顯示銀行名稱及其下的帳號。 由於銀行名稱始終為空。

銀行和帳號可以增長，在這種情況下，我希望它是動態的。 但是，當我嘗試在最后一家銀行添加帳號時，它停止粘貼附加帳號。 另外如果代碼還可以改進嗎？

總而言之，我想獲取銀行下的帳號列表。 得到它后，我將在它循環到另一家銀行和帳號之前做一些其他任務。 但我還沒有包含在下面的代碼中：

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

預期結果：

Answer 1

你可以試試下面的代碼。 在需要時更新工作表參考！

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