VBA:循环浏览各种Excel文件并将一个副本复制到主文件中

时间:2018-07-25 08:55:39

标签: vba excel-vba

我需要VBA代码,该代码可打开文件夹中的所有xlxs文件,并复制每个文件的特定列,并将此数据放入主表中。所有数据都需要复制到主表的第一列中,并且总是在下面添加新数据。

对于没有电源查询的旧版Excel,我尝试过此操作,但它不起作用:-(

 Sub LoopAllExcelFilesInFolder()
    Dim lastRow As Integer
    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String

Dim FldrPicker As FileDialog

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual


  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

  myExtension = "*.xls*"

  myFile = Dir(myPath & myExtension)

  Do While myFile <> ""

      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    lastRow = Workbooks("SUMMARY.xlsm").Sheets("Sheet1").Cells(Rows.Count, 9).End(xlUp).Row

      DoEvents


    wb.Worksheets(1).Range(Cells(2, 6), Cells(150, 6)).Copy_ Workbooks("SUMMARY.xlsm").Worksheets("Sheet1").Range(Cells(lastRow + 1, 1), Cells(lastRow + 150, 1))


       wb.Close SaveChanges:=True

         DoEvents


      myFile = Dir
  Loop


ResetSettings:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:2)

Excel 2016内置了一个称为PowerQuery的新工具,该工具相当简单,非常适合此类操作,并且比VBA简单得多。有关示例,请参见Microsoft的网站https://support.office.com/en-us/article/combine-files-in-a-folder-with-combine-binaries-power-query-94b8023c-2e66-4f6b-8c78-6a00041c90e4,或访问Google“合并文件”和“ PowerQuery”,您将看到成千上万的教程,视频等,它们将详细演示如何进行此操作。