將具有相同名稱的不同工作簿中的表合併到主工作簿中

因此，我有大約21張工作表，這些工作表在大約16個文件中全部命名完全相同。所有的格式和格式都完全相同，例如我需要將所有16個文件中包含「年齡」的所有工作表合併到一個主文件中，該文件將包含所有16個「年齡」的彙總數據的「年齡」牀單。對於其他20種紙張類型也是如此。將具有相同名稱的不同工作簿中的表合併到主工作簿中

我不知道如何完全做到這一點。我有一個宏，目前將一個文件中的所有工作表一起添加到一個主工作簿中，並且我正在修改該工作簿，以便合併類似的工作表而不是將它們全部添加到一個工作簿中。任何想法，將不勝感激！

Sub AddAllWS() 
Dim wbDst As Workbook 
Dim wbSrc As Workbook 
Dim wsSrc As Worksheet 
Dim MyPath As String 
Dim strFilename As String 

Application.DisplayAlerts = False 
Application.EnableEvents = False 
Application.ScreenUpdating = False 

MyPath = "C:\Documents and Settings\path\to" 
Set wbDst = ThisWorkbook 
strFilename = Dir(MyPath & "\*.xls", vbNormal) 

If Len(strFilename) = 0 Then Exit Sub 

Do Until strFilename = "" 

     Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename) 

     Set wsSrc = wbSrc.Worksheets(1) 

     wsSrc.UsedRange.Copy 

     wsSrc.Paste (wbSrc.Range("A" & Rows.Count).End(xlUp).Offset(1)) 


     wbSrc.Close False 

    strFilename = Dir() 

Loop 
wbDst.Worksheets(1).Delete 

Application.DisplayAlerts = True 
Application.EnableEvents = True 
Application.ScreenUpdating = True 

End Sub

來源

2016-09-06 ThePangloss

匆匆一瞥，請注意您如何在工作表中添加「Range」？你*必須*對'Rows.Count'，'Columns.Count'，'Cells（）'等做相同的處理，否則VBA會很快變得混亂。試試看看它是否解決了你的問題。（至少，這將有助於收緊代碼！） – BruceWayne

您似乎正在複製並粘貼到同一個源工作表中。檢查下面的代碼。這可能會起作用。我在代碼中加入了評論。

Sub AddAllWS() 
    Dim wbDst As Workbook 
    Dim wsDst As Worksheet 
    Dim wbSrc As Workbook 
    Dim wsSrc As Worksheet 
    Dim MyPath As String 
    Dim strFilename As String 
    Dim lLastRow As Long 

    Application.DisplayAlerts = False 
    Application.EnableEvents = False 
    Application.ScreenUpdating = False 

    Set wbDst = ThisWorkbook 

    MyPath = "C:\Documents and Settings\path\to\" 
    strFilename = Dir(MyPath & "*.xls*", vbNormal) 

    Do While strFilename <> "" 

      Set wbSrc = Workbooks.Open(MyPath & strFilename) 

      'loop through each worksheet in the source file 
      For Each wsSrc In wbSrc.Worksheets 
       'Find the corresponding worksheet in the destination with the same name as the source 
       On Error Resume Next 
       Set wsDst = wbDst.Worksheets(wsSrc.Name) 
       On Error GoTo 0 
       If wsDst.Name = wsSrc.Name Then 
        lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row + 1 
        wsSrc.UsedRange.Copy 
        wsDst.Range("A" & lLastRow).PasteSpecial xlPasteValues 
       End If 
      Next wsSrc 

      wbSrc.Close False 
      strFilename = Dir() 
    Loop 

    Application.DisplayAlerts = True 
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
End Sub

來源

2016-09-06 20:34:36 Coolshaikh

將具有相同名稱的不同工作簿中的表合併到主工作簿中

回答

相關問題