本Excel工具可高效地将同一文件夹内多个工作簿的所有工作表数据合并至单一表格,便于数据分析与整理。
以下是合并当前目录下所有工作簿的全部工作表至一个表中的VBA代码:
```vba
Sub 合并所有工作簿的工作表()
Dim MyFolder As String, StrFile As String, LastRow As Long
Dim wsDest As Worksheet, wbSource As Workbook
Application.ScreenUpdating = False 关闭屏幕更新以提高速度
Set wsDest = ThisWorkbook.Sheets.Add 在当前工作簿中添加一个新表作为目标表
MyFolder = GetFolder.Path 获取文件夹路径
StrFile = Dir(MyFolder & \*.xls*) 查找第一个Excel文件
Do While Len(StrFile) > 0 当找到的文件不为空时执行以下操作
Set wbSource = Workbooks.Open(Filename:=MyFolder & \ & StrFile)
For Each ws In wbSource.Sheets 遍历源工作簿中的所有表
LastRow = wsDest.Cells(wsDest.Rows.Count, A).End(xlUp).Row + 1 获取目标表的最后一个数据行并增加一行
If LastRow = 2 Then
ws.Range(1:50).Copy Destination:=wsDest.Range(A & Rows.Count).End(xlUp)(2) 如果是第一个文件,则复制前50行(包括标题)
Else
ws.Range(6:50).Copy Destination:=wsDest.Cells(LastRow, 1) 其他文件从第6行开始复制,避免重复标题
End If
Next ws
wbSource.Close SaveChanges:=False 关闭源工作簿不保存更改
StrFile = Dir 查找下一个Excel文件
Loop
Application.ScreenUpdating = True 开启屏幕更新
End Sub
Function GetFolder() As String
Dim oFolderBrowserDialog As Object
Set oFolderBrowserDialog = CreateObject(Shell.Application).BrowseForFolder(0, 请选择一个文件夹, 17)
If (Not oFolderBrowserDialog Is Nothing) And (oFolderBrowserDialog.Items.Count > 0) Then GetFolder = oFolderBrowserDialog.self.Path
End Function
```
这段代码将当前目录下所有Excel工作簿中的每个表合并到一个新的工作簿中,其中排除了重复的标题行。请根据实际需求调整复制的具体范围和条件。
注意:在运行此宏前,请确保关闭要处理的所有文件以避免可能的数据丢失或错误。