如果表不算太多的話可以試試這種方法，開啟總表（要貼上的表），開啟一個要複製的表，右擊要複製的工作表標籤，選擇移動或複製工作表，建立副本，選擇要移動到表（要貼上的那總表）。這種方法對合併到同一個檔案中還是可行的。但你說的彙總到一張表裡就不行了，可以試試用“＝”建立連結（要用相對地址），但這種方法對錶結構相同或類似的才可以，而且檔名和表名稱要有規律。這樣會很快彙總到一張表中，下面的活兒就是整理一下的工作了，要是要資料的話就把連結改成資料才可以，這種方法好在可以動態更新你的資料。寫程式碼也可以，但若是工作量很大的話可考慮！ 新建一個工作表，命名後儲存到和與合併的100個檔案同一個檔案資料夾，摁 alt + f11,雙擊工程資源管理器裡面的sheet1(sheet1),在右側的程式碼區貼上如下程式碼。執行。等候一會就OK了。 Sub 合併當前目錄下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & "\" & "*.xls") AWbName = ActiveWorkbook.Name Num = 0 Do While MyName "" If MyName AWbName Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet .Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1) Next WbN = WbN & Chr(13) & Wb.Name Wb.Close False End With End If MyName = Dir Loop Range("A1").Select Application.ScreenUpdating = True MsgBox "共合併了" & Num & "個工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示" End Sub
如果表不算太多的話可以試試這種方法，開啟總表（要貼上的表），開啟一個要複製的表，右擊要複製的工作表標籤，選擇移動或複製工作表，建立副本，選擇要移動到表（要貼上的那總表）。這種方法對合併到同一個檔案中還是可行的。但你說的彙總到一張表裡就不行了，可以試試用“＝”建立連結（要用相對地址），但這種方法對錶結構相同或類似的才可以，而且檔名和表名稱要有規律。這樣會很快彙總到一張表中，下面的活兒就是整理一下的工作了，要是要資料的話就把連結改成資料才可以，這種方法好在可以動態更新你的資料。寫程式碼也可以，但若是工作量很大的話可考慮！ 新建一個工作表，命名後儲存到和與合併的100個檔案同一個檔案資料夾，摁 alt + f11,雙擊工程資源管理器裡面的sheet1(sheet1),在右側的程式碼區貼上如下程式碼。執行。等候一會就OK了。 Sub 合併當前目錄下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & "\" & "*.xls") AWbName = ActiveWorkbook.Name Num = 0 Do While MyName "" If MyName AWbName Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet .Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1) Next WbN = WbN & Chr(13) & Wb.Name Wb.Close False End With End If MyName = Dir Loop Range("A1").Select Application.ScreenUpdating = True MsgBox "共合併了" & Num & "個工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示" End Sub