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