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

Jer*_*rry 5 excel vba excel-vba

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

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

表1:

    A         B
1 Header1   Header2
2 Text1     Info1
3 Text2     Info2
Run Code Online (Sandbox Code Playgroud)

表2:

    A         B
1 Header1   Header2
2 Text3     Info3
3 Text4     Info4
Run Code Online (Sandbox Code Playgroud)

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

    A         B
1 Header1   Header2
2 Text1     Info1
3 Text2     Info2
4 Text3     Info3
5 Text4     Info4
Run Code Online (Sandbox Code Playgroud)

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

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

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

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
Run Code Online (Sandbox Code Playgroud)

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

Sco*_*man 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
Run Code Online (Sandbox Code Playgroud)