循环文件并将可变范围的数据复制到主工作簿

Question

我需要将 1 个文件夹中的多个文件中的数据复制到主工作簿上的单个工作表（全部在同一张工作表上，一个在另一个工作表下面）。 各个工作表的数据都具有相同的列数 (A:J) 并从第 1 行开始，但行数都不同。

有什么想法吗？ 谢谢！！

我有一个代码可以复制每张纸的顶行数据，但我无法让它复制所有数据。

Answer 1

从这里开始示例：

'combine data from different excel files into one spreadsheet
Sub files_combine_into_one()
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim strPath$, Pivot$, sSourceName$, x&
    Dim oFldialog As FileDialog
    Dim oFile As Scripting.File
    Dim oFolder
    
    Set oFldialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    With oFldialog
        If .Show = -1 Then
            .Title = "Select a Folder"
            .AllowMultiSelect = False
            .InitialFileName = strPath
            sFolderName = .SelectedItems(1)
        End If
    End With
    
    Set oFolder = fso.GetFolder(sFolderName)
    
    Workbooks.Add: Pivot = ActiveWorkbook.Name 'Destination workbook
    For Each oFile In oFolder.Files
        Workbooks(Pivot).Activate
        
        x = Workbooks(Pivot).Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row + 2
        
        Workbooks.Open Filename:=oFile: sSourceName = ActiveWorkbook.Name
        Workbooks(sSourceName).Activate
        Workbooks(sSourceName).Sheets("SHEETNAME").UsedRange.Copy 'replace SHEETNAME by required Sheet Name
                                                                 
        Workbooks(Pivot).Activate
        Workbooks(Pivot).Sheets("Sheet1").Cells(x, 1).PasteSpecial xlPasteValues 'or xlPasteAll
        Application.CutCopyMode = False
        Workbooks(sSourceName).Close False
    Next
End Sub

Answer 2

Excel 中的 VBA（Visual Basic for Applications）可用于将文件夹中多个文件的数据复制到主工作簿。这是一个帮助您入门的简单示例：

Sub CopyDataFromFilesToMasterWorkbook()
    Dim MasterWorkbook As Workbook
    Dim SourceWorkbook As Workbook
    Dim SourceWorksheet As Worksheet
    Dim MasterWorksheet As Worksheet
    Dim SourceFolder As String
    Dim FileName As String
    Dim LastRowMaster As Long
    Dim LastRowSource As Long
    Dim CopyRange As Range
    
    ' Set the path to the folder containing the files
    SourceFolder = "C:\Your\Folder\Path\" ' Update with your folder path
    
    ' Set the master workbook and worksheet
    Set MasterWorkbook = Workbooks("MasterWorkbook.xlsx") ' Update with your master workbook name
    Set MasterWorksheet = MasterWorkbook.Sheets("Sheet1") ' Update with your master worksheet name
    
    ' Loop through each file in the folder
    FileName = Dir(SourceFolder & "*.xlsx") ' Update the file extension if needed
    Do While FileName <> ""
        ' Open the source workbook
        Set SourceWorkbook = Workbooks.Open(SourceFolder & FileName)
        
        ' Set the source worksheet (assuming the sheet is the first sheet in each workbook)
        Set SourceWorksheet = SourceWorkbook.Sheets(1)
        
        ' Find the last used row in the master worksheet
        LastRowMaster = MasterWorksheet.Cells(MasterWorksheet.Rows.Count, "A").End(xlUp).Row
        
        ' Find the last used row in the source worksheet
        LastRowSource = SourceWorksheet.Cells(SourceWorksheet.Rows.Count, "A").End(xlUp).Row
        
        ' Define the range to copy (from A1 to the last used column in row J)
        Set CopyRange = SourceWorksheet.Range("A1:J" & LastRowSource)
        
        ' Copy the data to the master worksheet starting from the next row
        CopyRange.Copy MasterWorksheet.Range("A" & LastRowMaster + 1)
        
        ' Close the source workbook without saving changes
        SourceWorkbook.Close False
        
        ' Move to the next file
        FileName = Dir
    Loop
    
    ' Clean up
    Set MasterWorkbook = Nothing
    Set SourceWorkbook = Nothing
    Set SourceWorksheet = Nothing
    Set MasterWorksheet = Nothing
    Set CopyRange = Nothing
End Sub

此代码假设您有一个主工作簿，其中包含一个名为“Sheet1”的工作表，并且源文件位于指定的文件夹中。请将“MasterWorkbook.xlsx”替换为您的主工作簿的名称，并相应地更新源文件夹路径。

在运行代码之前，保存主工作簿，并考虑创建备份，特别是当您使用修改文件的 VBA 代码时。