将具有相同名称的不同工作簿中的表合并到主工作簿中
问题描述:
因此,我有大约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
答
您似乎正在复制并粘贴到同一个源工作表中。检查下面的代码。这可能会起作用。我在代码中加入了评论。
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
匆匆一瞥,请注意您如何在工作表中添加“Range”?你*必须*对'Rows.Count','Columns.Count','Cells()'等做相同的处理,否则VBA会很快变得混乱。试试看看它是否解决了你的问题。 (至少,这将有助于收紧代码!) – BruceWayne