将许多工作簿中的表3合并到一个新工作簿中

时间:2017-07-06 19:09:13

标签: excel vba excel-vba

我有77本工作簿,需要将所有这些工作簿中的工作表3合并为一个新工作簿中的工作表。多年来我没有这样做过。我真的很感激任何帮助。我从其他网页修改了一些代码,但它对我不起作用。

谢谢你,M

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

以下是我可以根据您的需求量身定制的东西

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

它可能无法正常 ,但它应该指向正确的路径