需求如果您有多个Excel文件，并且每个文件都包含一个名为wsData的工作表，您想要从每个文件的wsData工作表中复制数据到同一个wsOutput工作表中，同时保留每个wsData工作表的表头，那么您需要编写一个能够循环遍历文件夹中所有Excel文件，并逐个打开它们以执行复制操作的VBA宏。 以下是一个示例代码，它假设所有的Excel文件都位于一个特定的文件夹中，并且每个文件都有一个名为wsData的工作表。该宏将打开每个文件，复制wsData的表头到wsOutput（如果它是第一个文件，或者如果之前的文件已经复制了表头，则不会重复复制），然后复制数据到wsOutput的下一行。 VBA代码实现Sub CopyDataFromMultipleFiles() Dim folderPath As String Dim fileName As String Dim wbData As Workbook Dim wsData As Worksheet Dim wsOutput As Worksheet Dim rngHeader As Range Dim lastRowOutput As Long Dim firstFile As Boolean ' 设置输出工作簿和输出工作表 Set wsOutput = ThisWorkbook.Sheets('Output') ' 清除输出工作表的内容（如果需要） wsOutput.Cells.Clear ' 设置文件夹路径 folderPath = 'F:\practice\vba-demo\data\' fileName = Dir(folderPath & '*.xls') ' 假设文件是.xlsx格式 firstFile = True ' 标记是否为第一个文件，以决定是否复制表头 If fileName = '' Then MsgBox '目录：' & folderPath & '下没有找到.xls文件' End End If ' 循环遍历文件夹中的每个文件 Do While fileName <> '' ' 构建完整的文件路径 Dim fullFilePath As String fullFilePath = folderPath & fileName ' 打开工作簿 Set wbData = Workbooks.Open(fullFilePath) ' 设置wsData工作表 Set wsData = wbData.Sheets('wsData') ' 检查是否找到了wsData工作表 If Not wsData Is Nothing Then ' 复制表头到输出工作表（仅当处理第一个文件时） If firstFile Then Set rngHeader = wsData.Range('A1').CurrentRegion.Rows(1) ' 假设表头在第一行 rngHeader.Copy Destination:=wsOutput.Range('A1') firstFile = False ' 标记已经复制过表头 End If ' 找到输出工作表的最后一行 lastRowOutput = wsOutput.Cells(wsOutput.Rows.Count, 'A').End(xlUp).Row 1 ' 复制数据到输出工作表 wsData.Range('A2').CurrentRegion.Offset(1, 0).Copy Destination:=wsOutput.Cells(lastRowOutput, 1) Else MsgBox '在文件 '' & fullFilePath & '' 中未找到名为 'wsData' 的工作表。' End If ' 关闭工作簿，不保存更改 wbData.Close SaveChanges:=False ' 获取下一个文件名 fileName = Dir() Loop ' 提示操作完成 MsgBox '数据已从多个文件中复制到输出工作表。'End Sub在这个宏中，我们首先设置了输出工作簿和输出工作表，并清除了输出工作表的内容（如果需要的话）。然后，我们定义了文件夹路径，并使用Dir函数遍历该文件夹中的所有Excel文件。对于每个文件，我们打开它，检查是否存在名为wsData的工作表，并复制表头和数据到输出工作表。在复制数据之前，我们找到输出工作表的最后一行，以便将数据放在正确的位置。最后，我们关闭工作簿并不保存更改，然后继续处理下一个文件，直到遍历完所有文件。 请注意，这个宏假设所有wsData工作表的表头都在第一行，并且数据区域紧接着表头。如果您的实际情况有所不同，您可能需要调整rngHeader和复制数据范围的代码以适应您的具体情况。此外，确保将文件夹路径更改为包含您Excel文件的实际文件夹路径。 |
|
|
