关于vba:将excel电子表格合并为一个电子表格

Merging excel spreadsheets into one spreadsheet

好的,我试图寻找类似的问题,但是由于这是我第一次查看Excel的VBA编辑器,因此我对所讨论的内容不甚了解。

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

表格1:

1
2
3
4
    A         B
1 Header1   Header2
2 Text1     Info1
3 Text2     Info2

表格2:

1
2
3
4
    A         B
1 Header1   Header2
2 Text3     Info3
3 Text4     Info4

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

1
2
3
4
5
6
    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)。

2)我已经看过函数" ActiveCell.SpecialCells(xlLastCell).Select"(当我使用Ctrl + End时激活),但该函数将我带到了表格的末尾。使用该功能使其最佳工作后,我需要类似于" Home"和" Down"箭头键的东西。

这些选择之一对我来说都很好。 ^ _ ^

这是我当前从Excel 2010中的宏记录器记录的VBA代码:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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

我希望我不要忘记任何有用的信息。让我知道我是否做到了!


杰瑞,尝试这段代码。 我对您的代码进行了一些整理,使它能够更有效地执行您希望执行的操作。 我已经根据您的代码所说的认为是正确的做出了一些假设。 如果没有,请对此答案发表评论,如果需要,我会进行调整。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
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


如果有人想在创建Shee3之前先删除它,以避免Error

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

谢谢斯科特·霍尔茨曼!