vba 将 Excel 电子表格合并为一个电子表格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/13686323/
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
Merging excel spreadsheets into one spreadsheet
提问by Jerry
Okay, I tried to look for similar questions but I didn't understand much of what was being discussed since it's the first time I'm looking at Excel's VBA editor.
好的，我试图寻找类似的问题，但我不太了解正在讨论的内容，因为这是我第一次查看 Excel 的 VBA 编辑器。
In simple terms, I have 2 spreadsheets: "Sheet1" and "Sheet2"
简单来说，我有 2 个电子表格：“Sheet1”和“Sheet2”
Sheet 1:
第 1 页：
A B
1 Header1 Header2
2 Text1 Info1
3 Text2 Info2
Sheet 2:
第 2 页：
A B
1 Header1 Header2
2 Text3 Info3
3 Text4 Info4
And I would like to have a macro to merge the two sheets into a new sheet (Sheet3), like this:
我想要一个宏来将两个工作表合并成一个新工作表（Sheet3），如下所示：
A B
1 Header1 Header2
2 Text1 Info1
3 Text2 Info2
4 Text3 Info3
5 Text4 Info4
I have tried recording a macro and saving it for later use. To do this, I created a new sheet, copy/paste everything from Sheet1 to Sheet3, then copy all the information except the headings from Sheet2 to Sheet3.
我曾尝试录制宏并保存以备后用。为此，我创建了一个新工作表，将所有内容从 Sheet1 复制/粘贴到 Sheet3，然后将除标题之外的所有信息从 Sheet2 复制到 Sheet3。
Well, the macro works for this data, but I found that the code generated by excel makes it so it selects the cell A4 (here) before pasting the data. While this works for this data, it wouldn't work if the number of records in each sheet changes now and again. Basically,
好吧，该宏适用于这些数据，但我发现 excel 生成的代码使它在粘贴数据之前选择单元格 A4（此处）。虽然这适用于这些数据，但如果每个工作表中的记录数量时不时发生变化，它就不起作用。基本上，
1) I was wondering if there was a function that goes to the last relevant cell automatically before pasting the next set of data (in this example, cell A4, and if I have one more table, then cell A6).
1）我想知道是否有一个函数可以在粘贴下一组数据之前自动转到最后一个相关单元格（在本例中，单元格 A4，如果我还有一个表格，那么单元格 A6）。
2) I've seen the function "ActiveCell.SpecialCells(xlLastCell).Select" (activated when I use Ctrl+End) but that carries me to the end of the sheet. I would need something similar to "Home" and "Down" arrow key after using that function for it to work best.
2) 我已经看到了函数“ActiveCell.SpecialCells(xlLastCell).Select”（当我使用 Ctrl+End 时被激活）但是它把我带到了工作表的末尾。使用该功能后，我需要类似于“主页”和“向下”箭头键的东西才能使其发挥最佳效果。
Either one of those options would be good with me. ^_^
这些选项中的任何一个都对我有好处。^_^
Here's my current VBA code recorded from the Macro Recorder in excel 2010:
这是我从 excel 2010 中的宏记录器记录的当前 VBA 代码：
Sub Collate_Sheets()
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Name = "Sheet3"
Sheets("Sheet1").Select
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
ActiveCell.SpecialCells(xlLastCell).Select
' I need to select one cell below, and the cell in column A at this point
Sheets("Sheet2").Select
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
End Sub
I hope I didn't forget any useful piece of information. Let me know if I did!
我希望我没有忘记任何有用的信息。如果我做了，请告诉我！
回答by Scott Holtzman
Jerry, try this code. I cleaned up your code a bit and made it more efficient to be able to do what you wish. I've made some assumptions based on what your code said which I think are right. If not, comment on this answer and I will tweak if needed.
杰瑞，试试这个代码。我稍微清理了您的代码，使其更高效，以便能够做您想做的事。我根据您的代码所说的内容做出了一些假设，我认为这些假设是正确的。如果没有，请对此答案发表评论，如果需要，我会进行调整。
Option Explicit
Sub Collate_Sheets()
Sheets.Add After:=Sheets(Sheets.Count)
Dim wks As Worksheet
Set wks = Sheets(Sheets.Count)
wks.Name = "Sheet3"
With Sheets("Sheet1")
Dim lastrow As Long
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A1:B" & lastrow).Copy wks.Range("A" & wks.Rows.Count).End(xlUp)
End With
With Sheets("Sheet2")
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A2:B" & lastrow).Copy wks.Range("A" & wks.Rows.Count).End(xlUp).Offset(1)
End With
End Sub
回答by enam
In case anybody wants to delete Shee3 before created it to avoid the Error
如果有人想在创建 Shee3 之前删除它以避免错误
'Delete Sheet 3
Application.DisplayAlerts = False
Sheets("Sheet3").Delete
Thanks Scott Holtzman!!
谢谢斯科特·霍尔兹曼！！
