excel - 循环问题 VBA - 粘贴在最后一行

Question

我对 VBA 还很陌生，并且很难理解为什么我的宏不起作用。
上下文:
我有一个包含 3 张工作表的 Excel 工作簿:

带有名称列表的工作表“部门”

带有帐户列表的工作表“帐户”

表“部门和帐户”，我的输出应该是

我想做的
我想要 :

从工作表“帐户”中复制所有帐户的列表，并将其粘贴到工作表“部门和帐户”的 A 列

转到工作表“部门”，复制第一个部门名称

转到工作表“部门和帐户”并将部门名称粘贴到 B 列中，直到帐户

旁边

重复直到我的所有部门都被粘贴

所需输出
我将拥有一个包含所有帐户的集团，旁边有一个部门，并且与列表中的部门一样多的集团。在工作表上，它看起来像这样:
extract excel
到目前为止我的代码

Sub Macro1()
'
' Macro1 Macro
'
Dim lrow As Long
Dim i As Integer

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


For i = 1 To 47

Sheets("Accounts").Select
Range("A2:A178").Select
Selection.Copy

Sheets("Account and Dpt").Select
Range("A" & lrow + 1).Select
ActiveSheet.Paste

Sheets("Departments").Select '
Range("B" & i + 1).Select
Application.CutCopyMode = False
Selection.Copy

Sheets("Account and Dpt").Select
Range("B" & lrow + 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste

i = i + 1

Next i

End Sub

当我运行它时 - 没有任何 react ；你能帮我理解如何解决它吗？
非常感谢!!

Answer 1

粘贴帐户后更新 lrow

Option Explicit

Sub Macro1()
    '
    ' Macro1 Macro
    '
    Dim lrow As Long, i As Integer
    lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To 47
    
        Sheets("Accounts").Select
        Range("A2:A178").Select
        Selection.Copy
        
        Sheets("Account and Dpt").Select
        Range("A" & lrow + 1).Select
        ActiveSheet.Paste
        
        Sheets("Departments").Select '
        Range("B" & i + 1).Select
        Application.CutCopyMode = False
        Selection.Copy
            
        Sheets("Account and Dpt").Select
        lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
        Range("B" & lrow).Select
        Range(Selection, Selection.End(xlUp).Offset(1)).Select
        ActiveSheet.Paste
    
    Next i
End Sub

或者更简单地说

Sub Macro2()
 
    Dim lrow As Long, i As Integer
    
    Application.ScreenUpdating = False
    For i = 1 To 47
        lrow = Sheets("Account and Dpt").Cells(Rows.Count, 1).End(xlUp).Row
    
        Sheets("Accounts").Range("A2:A178").Copy _
            Sheets("Account and Dpt").Range("A" & lrow + 1)
        
        Sheets("Departments").Range("B" & i + 1).Copy _
            Sheets("Account and Dpt").Range("B" & lrow + 1).Resize(177)
        
    Next i
    Application.ScreenUpdating = True

End Sub