将来自许多工作簿的工作表3合并为一个新工作簿

我有77个工作簿，需要将工作表3全部合并到新的工作簿中。 我好几年没有这样做过。 我真的很感激任何帮助。 我修改了其他网页的一些代码，但它不适合我。

谢谢你

Answer 1

如果他们都在一个文件夹然后这个工程：

Sub CopySheetsOver() Dim Path As String, Filename As String Dim wbk As Workbook Dim wsh As Worksheet Path = "C:\Users\MaryGM\Desktop\YourFolder\" 'set the path to the desired folder Filename = Dir(Path & "*.xls") 'get names of all xls files, change to xlsx if desired Do While Filename <> "" 'loop over all the xlsx files in that folder Workbooks.Open Filename:=Path & Filename, ReadOnly:=True Set wbk = ActiveWorkbook If wbk.Worksheets.Count > 2 Then 'check if the third sheet exists Set wsh = wbk.Sheets(3) wsh.Copy After:=ThisWorkbook.Sheets(1) 'set the name to be combination of original sheet name and its corresponding workbook: ThisWorkbook.ActiveSheet.Name = wbk.Name & "-" & wsh.Name End If Workbooks(Filename).Close Filename = Dir() Loop End Sub 

Answer 2

这是我可以根据你的需要量身定做的

 Sub ConslidateWorkbooks() 'Code to pull sheets from multiple Excel files in one file directory 'into master "Consolidation" sheet. Dim FolderPath As String Dim Filename As String Dim Sheet As Worksheet Application.ScreenUpdating = False FolderPath = "[REDACTED]" Filename = Dir(FolderPath & "*.xlsx") Do While Filename <> "" Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True copyOrRefreshSheet ThisWorkbook, Sheets(3) Workbooks(Filename).Close Filename = Dir() Loop Application.ScreenUpdating = True End Sub Sub copyOrRefreshSheet(destWb As Workbook, sourceWs As Worksheet) Dim ws As Worksheet On Error Resume Next Set ws = destWb.Worksheets(sourceWs.Name) On Error GoTo 0 If ws Is Nothing Then sourceWs.Copy After:=destWb.Worksheets(destWb.Worksheets.Count) Else ws.Cells.ClearContents ws.Range(sourceWs.UsedRange.Address).Value = sourceWs.UsedRange.Value2 End If End Sub 

它可能无法完美运行 ，但它应该指向正确的道路