将多个工作簿中的数据复制并粘贴到另一个工作簿中的工作表中

希望您能提供帮助。我目前有一段代码见下文。我希望它允许用户选择包含工作簿的文件夹。然后打开每个工作簿，从每个工作簿中选择一个名为“ SearchCaseResults”的工作表，将来自第二行的每个“ SearchCaseResults”中的数据从第二行向下复制到最后使用的行，并将此数据粘贴到位于另一工作簿中的名为“ Disputes”的工作表中。另一个文件夹。

因此，在PIC 1中，您可以看到三个工作簿England，England_2和England_3，每个工作簿都包含一个工作表“ SearchCaseResults”，因此，我基本上需要执行的代码是循环打开文件夹，打开England工作簿，然后选择工作表“ SearchCaseResults”，复制数据从第2行到最后使用的行，然后将其粘贴到另一个工作簿的“ Disputes”工作表中的另一个文件夹中，然后选择下一个工作簿England_2，选择该工作簿中的工作表“ SearchCaseResults”，从该行复制该工作表上的数据2到最后使用的行，然后将其粘贴到“争议”工作表中从前一个工作表（英格兰）复制的数据的下面，然后继续此复制和粘贴过程，直到文件夹中没有剩余的工作簿为止。

目前，我所拥有的代码正在打开工作簿，这很好，并且可以从每个工作簿中选择/激活“ SearchCaseResults”工作表，但这只是处理英格兰表中的单元格A2，然后仅粘贴最后一个中的数据工作表到目标工作表中。（我怀疑粘贴了以前工作表中的数据）可以修改我的代码，以将每个“ SearhCaseResults”工作表中的数据从A2复制到最后使用的行，然后粘贴到每个工作表下的“争议”工作表中其他。

到目前为止，这里是我的代码，非常感谢所有帮助。

码

Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog


'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "C:\Users\CONNELLP\Desktop\Claire Macro\Copy and Paste Disputes\Report Sheet\"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Ensure Workbook has opened before moving on to next line of code
      DoEvents

    'Copy data on "SearchCaseResults" sheet to "Disputes" Sheet in other workbook

Dim lRow As Long

Dim ws2 As Worksheet

lRow = Range("A" & Rows.Count).End(xlUp).Row

Set y = Workbooks.Open("C:\Users\CONNELLP\Desktop\Claire Macro\Copy and Paste Disputes\Report Sheet")

Set ws2 = y.Sheets("Disputes")

      wb.Worksheets("SearchCasesResults").Range("A2" & lRow).Copy
      With y

      ws2.Range("A2").PasteSpecial
      End With



    'Save and Close Workbook
      wb.Close SaveChanges:=True

    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

我应该指出，上面的代码是从带有命令按钮的单独工作簿中运行的。

见图2

图1

图2