将Excel电子表格合并到一个电子表格中

时间:2012-12-03 15:25:40

标签: excel vba excel-vba

好的,我试图寻找类似的问题,但我不太了解正在讨论的内容,因为这是我第一次看到Excel的VBA编辑器。

简单来说,我有2个电子表格:“Sheet1”和“Sheet2”

表1:

    A         B
1 Header1   Header2
2 Text1     Info1
3 Text2     Info2

表2:

    A         B
1 Header1   Header2
2 Text3     Info3
3 Text4     Info4

我希望有一个宏将两张纸合并成一张新纸张(Sheet3),如下所示:

    A         B
1 Header1   Header2
2 Text1     Info1
3 Text2     Info2
4 Text3     Info3
5 Text4     Info4

我已尝试录制宏并将其保存以供日后使用。为此,我创建了一个新工作表,复制/粘贴从Sheet1到Sheet3的所有内容,然后将除Sheet2之外的所有信息复制到Sheet3。

嗯,这个宏适用于这个数据,但是我发现excel生成的代码使它在粘贴数据之前选择了单元格A4(这里)。虽然这适用于此数据,但如果每张表中的记录数量不断变化,则无法使用。基本上,

1)我想知道是否有一个函数在粘贴下一组数据之前自动进入最后一个相关单元格(在本例中,单元格A4,如果我还有一个表格,那么单元格A6)。 / p>

2)我已经看过函数“ActiveCell.SpecialCells(xlLastCell).Select”(当我使用Ctrl + End时激活)但是它将我带到了工作表的末尾。使用该功能后,我需要类似“Home”和“Down”箭头键的功能,以使其发挥最佳效果。

这些选项中的任何一个对我都不错。 ^ _ ^

这是我在excel 2010中从Macro Recorder录制的当前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

我希望我没有忘记任何有用的信息。如果我做了,请告诉我!

2 个答案:

答案 0 :(得分:6)

杰瑞,试试这段代码吧。我稍微清理了一下你的代码并使它更有效率,能够做你想做的事情。我根据你的代码所说的做了一些我认为正确的假设。如果没有,请对此答案发表评论,如果需要,我会进行调整。

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

答案 1 :(得分:0)

如果有人想在创建之前删除Shee3以避免错误

   'Delete Sheet 3
   Application.DisplayAlerts = False
   Sheets("Sheet3").Delete

感谢Scott Holtzman !!