我有77个工作簿,需要将工作表3全部合并到新工作簿中的一个工作表中。我好几年没有这样做过。我会很感激任何帮助。我修改了其他网页的一些代码,但它不适合我。将来自多个工作簿的工作表3合并到一个新工作簿中
谢谢,男
我有77个工作簿,需要将工作表3全部合并到新工作簿中的一个工作表中。我好几年没有这样做过。我会很感激任何帮助。我修改了其他网页的一些代码,但它不适合我。将来自多个工作簿的工作表3合并到一个新工作簿中
谢谢,男
这里是我有,你能满足你的需要
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
它可能无法正常工作完美,但它应该指向你在正确的道路上
如果他们都在一个文件夹中,那么这个工作:
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
是否在一个文件夹中处理所有工作簿? –
你好,是的,我已经为我正在使用的77个县创建了一个文件夹,并且我已经在同一个文件夹中创建了一个MergedCO工作簿 – MaryGM