创build填充工作簿的作品为第一次迭代，但不是更多的
我在编写一些VBA时遇到了一些问题，VBA的目的是从主电子表格中获取数据，并为每个线路pipe理器创build一组额外的工作簿。
它将从主工作簿中获取一个标题为“RoleAccess”的整张表格，并将整个工作表复制到每个新工作簿中（然后在重新命名Sheet1到RoleAccess中），然后它将通过pipe理员列表从“电子邮件列表”工作表中select主工作簿，并确定pipe理器下每个用户的访问权限，然后将其粘贴到新工作簿的工作表2中（之后再将工作表重命名为工作表Sheet2到UserAccess）。
这对列表中的第一个pipe理者来说是非常棒的，但是后续的pipe理者似乎完美地获得了他们的RoleAccess表，并且UserAccess的头部，但是他们没有得到剩余的行填充。 我已经validation了通过插入消息框进行链接没有任何问题，而且完全没有错误，只是在第一个工作簿完成之后，无法粘贴数据。
代码如下：
Sub Create_Output_Files() Application.ScreenUpdating = False Application.EnableEvents = False Dim RA As Worksheet Dim UA As Worksheet Dim Sum_WS As Worksheet Dim EL As Worksheet Dim LM As Worksheet Set RA = ActiveWorkbook.Sheets("RoleAccess") Set UA = ActiveWorkbook.Sheets("UserAccess") Set Sum_WS = ActiveWorkbook.Sheets("Summary") Set EL = ActiveWorkbook.Sheets("EmailList") Set LM = ActiveWorkbook.Sheets("LineManagers") 'Determine size of copy i = Application.WorksheetFunction.CountA(RA.Range("A:A")) j = Application.WorksheetFunction.CountA(RA.Range("A1:XFD1")) k = Application.WorksheetFunction.CountA(UA.Range("A1:XFD1")) l = Application.WorksheetFunction.CountA(EL.Range("A:A")) m = Application.WorksheetFunction.CountA(UA.Range("A:A")) For n = 2 To l 'Activate and copy data from Role Access sheet RA.Activate RA.Range(Cells(1, 1), Cells(i, j)).Copy 'Create new workbook Set NewWorkbook = Workbooks.Add Set ws1 = NewWorkbook.Sheets("Sheet1") Set ws2 = NewWorkbook.Sheets("Sheet2") 'Paste Role Access data into the workbook ws1.Range(Cells(1, 1), Cells(i, j)).PasteSpecial xlValues ws1.Range(Cells(1, 1), Cells(i, j)).PasteSpecial xlFormats ws1.Range(Cells(1, 1), Cells(i, j)).PasteSpecial xlPasteColumnWidths 'Freeze view ws1.Range("C2").Select ActiveWindow.FreezePanes = True 'Activate and copy header data from User Access sheet UA.Activate UA.Range(Cells(1, 1), Cells(1, k)).Copy 'Paste User Access header into new workbook ws2.Activate ws2.Range(Cells(1, 1), Cells(1, k)).PasteSpecial xlValues ws2.Range(Cells(1, 1), Cells(1, k)).PasteSpecial xlFormats ws2.Range(Cells(1, 1), Cells(1, k)).PasteSpecial xlPasteColumnWidths 'Activate and copy iterative data for each manager For p = 2 To m If UA.Cells(p, 1) = EL.Cells(n, 1) Then UA.Rows(p).Copy Destination:=ws2.Rows(p) Else 'Nothing End If Next p 'Change sheet name ws1.Name = "RoleAccess" ws2.Name = "UserAccess" 'Delete extra sheets Application.DisplayAlerts = False NewWorkbook.Sheets("Sheet3").Select ActiveWindow.SelectedSheets.Delete 'Save and close workbook NewWorkbook.SaveAs Filename:="C:\RemTP\Output Files\" & EL.Cells(n, 1) NewWorkbook.Close Next n 'Re-activate summary screen Sum_WS.Activate Application.ScreenUpdating = True Application.EnableEvents = True End Sub 任何想法都将受到高度赞赏，因为它会让我稍稍靠墙！
干杯
find答案：用户错误。 由于数据是按字母顺序排列的，因此信息在较低的一行发布。 因此，工作簿2的值从第4xx行开始，而不是第2行。
解决scheme是写一个循环，始终在第2行开始粘贴。
编辑：可能不是世界上最有效的代码，但使用了以下内容：
'Activate and copy iterative data for each manager For p = 2 To m If UA.Cells(p, 1) = EL.Cells(n, 1) Then UA.Rows(p).Copy Destination:=ws2.Rows(p) Else 'Nothing End If Next p 'Remove blank lines While ws2.Cells(2, "A") = "" Rows(2).Delete Shift:=xlUp Wend