将具有相同名称的不同工作簿中的表合并到主工作簿中

因此，我有大约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

将具有相同名称的不同工作簿中的表合并到主工作簿中

回答

相关问题