vba 将多个 Excel 工作表附加到一个工作表中
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16121770/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Append multiple Excel worksheets into one worksheet
提问by Kay
I have an excel file with 116 sheets that I want to append into one sheet ("Tab_Appended"). I tried the following code and it works. However, column A from the sheets is not pasted to Tab_Appended - where would I have to alter the code to achieve that all data, except the header row, is copied to Tab_Appended?
我有一个包含 116 张工作表的 excel 文件，我想将其附加到一张工作表中（“Tab_Appended”）。我尝试了以下代码并且它有效。但是，工作表中的 A 列未粘贴到 Tab_Appended - 我必须在哪里更改代码才能实现将除标题行以外的所有数据复制到 Tab_Appended？
BTW, I excluded several sheets with 'case' is there a more elegant way to exclude all sheets that contain the string "legend", rather than my listing of all sheets?
顺便说一句，我用“case”排除了几张工作表，是否有更优雅的方法来排除包含字符串“legend”的所有工作表，而不是我列出的所有工作表？
Sub SummurizeSheets()
Dim ws As Worksheet
Dim lastRng As Range
Dim lastCll As Range
Application.ScreenUpdating = False
Sheets("Tab_Appended").Activate
For Each ws In Worksheets
Set lastRng = Range("A65536").End(xlUp).Offset(1, 0)
Select Case ws.Name
Case "Tab_Appended", "Legende 1", "Legende 2", "Legende 3", "Legende 4", "Legende 5", "Legende 6", "Legende 7", "Legende 8", "Legende 9", "Legende 10", "Legende 11", "Legende 12", "Legende 13"
'do nothing
Case Else
Set lastCll = ws.Columns(1).Find(What:="*", After:=ws.Range("A1"), SearchDirection:=xlPrevious)
ws.Range("A2:" & lastCll.Address).Copy
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
'add sheet name before data
lastRng.Resize(lastCll.Row - 1) = ws.Name
End Select
Next ws
Columns("A").SpecialCells(xlBlanks).EntireRow.Delete (xlUp)
Application.ScreenUpdating = True
End Sub
采纳答案by Siddharth Rout
I have commented the code so that you will not have any problem understanding it.
我已经对代码进行了注释，以便您理解它不会有任何问题。
Regarding your question about ignoring the sheet which have Legend; Yes, there is an elegant way and that is using INSTR. See below.
关于您关于忽略具有的工作表的问题Legend；是的，有一种优雅的方式，那就是使用INSTR. 见下文。
What this code is doing is it copies the data from columns from all Non legend*sheets into Tab_AppendedA:M. Hope this is what you wanted? If not then let me know and I will rectify the post.
这段代码的作用是将所有工作Non legend*表的列中的数据复制到Tab_AppendedA:M 中。希望这是你想要的吗？如果没有，请告诉我，我会更正帖子。
Sub SummurizeSheets()
Dim wsOutput As Worksheet
Dim ws As Worksheet
Dim wsOLr As Long, wsLr As Long
Application.ScreenUpdating = False
'~~> Set this to the sheet where the output will be dumped
Set wsOutput = Sheets("Tab_Appended")
With wsOutput
'~~> Get Last Row in "Tab_Appended" in Col A/M and Add 1 to it
wsOLr = .Range("A:M").Find(What:="*", After:=.Range("A1"), _
Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row + 1
'~~> Loop through sheet
For Each ws In Worksheets
'~~> Check if the sheet name has Legende
Select Case InStr(1, ws.Name, "Legende", vbTextCompare)
'~~> If not then
Case 0
With ws
'~~> Get Last Row in the sheet
wsLr = .Range("A:M").Find(What:="*", After:=.Range("A1"), _
Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
'~~> Copy the relevant range
.Range("A2:M" & wsLr).Copy wsOutput.Range("A" & wsOLr)
'~~> Get Last Row AGAIN in "Tab_Appended" in Col A/B and Add 1 to it
wsOLr = wsOutput.Range("A:M").Find(What:="*", After:=wsOutput.Range("A1"), _
Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row + 1
End With
End Select
Next
End With
Application.ScreenUpdating = True
End Sub
回答by K_B
Disappearing column
消失的专栏
There is a strange bit of code in your snippet:
您的代码段中有一段奇怪的代码：
Columns("A").SpecialCells(xlBlanks).EntireRow.Delete (xlUp)
So after all sheets contents are copied this line deletes column A, this is not what you want.
因此，在复制所有工作表内容后，此行会删除 A 列，这不是您想要的。
Furthermore the code is wrong as deleting a column and then shift up (xlUp) is not possible. You can delete a row maybe and shift it up, or delete a column and shift it left.
此外，代码是错误的，因为删除一列然后向上移动 (xlUp) 是不可能的。您可以删除一行并将其向上移动，或者删除一列并将其向左移动。
As I said this code now makes your column A disappear... Deleting that line will keep your column A from disappearing!
正如我所说，此代码现在使您的 A 列消失...删除该行将防止您的 A 列消失！
Using cases
使用案例
To exclude certain sheets the use of case is fine, also the way you used it is good enough for a one off. To make it manageable for repetative usage I would suggest to store the list of sheets to exclude in a sheet as you can then drop or add sheet names to that list and dont have to go into the code.
要排除某些工作表，使用 case 很好，而且您使用它的方式也足以满足一次性使用。为了使其易于重复使用，我建议将要排除的工作表列表存储在工作表中，因为您可以将工作表名称删除或添加到该列表中，而不必进入代码。
