实时将来自多个工作表的数据合并到一个汇总工作表中

Question

我有多个数据工作表中的数据想要合并到摘要工作表中。 当用户更新任何数据工作表中的数据时，它会自动将信息复制到摘要工作表。

例如

（输入）数据工作表1

 |   A   |    B   |   C   |
    Cat      Red     Male
    Dog     Green   Female

（输入）数据工作表2

 |   A   |    B   |   C   |
  Monkey   Brown    Male
    Ant     Blue     Male
   Bird     White   Female

（输出）摘要工作表

 |   A   |    B   |   C   |
    Cat      Red     Male
    Dog     Green   Female
  Monkey    Brown    Male
    Ant     Blue     Male
   Bird     White   Female

现在我的代码在一张数据工作表上运行良好。但是当我尝试切换到另一个数据工作表时，汇总工作表上的数据将不正确。当我删除所有信息或更改代码时，它也会出现一些错误（我需要重新打开它）。

这是我的代码

这本工作簿

Public Sub Workbook_Open()

Set WB = ThisWorkbook
Set ActWS = WB.ActiveSheet
Set MainWS = WB.Worksheets("Main")

ActWSPreLastRow = ActWS.Cells(ActWS.Rows.Count, "A").End(xlUp).Row
MainWSPreLastRow = MainWS.Cells(MainWS.Rows.Count, "A").End(xlUp).Row

End Sub

模块

Public WB As Workbook
Public ActWS As Worksheet
Public MainWS As Worksheet
Public ActWSPreLastRow As Long
Public ActWSStoredLastRow As Long
Public MainWSPreLastRow As Long
Public MainWSStoredLastRow As Long
Public MainWSEndLastRow As Long
Public I As Long

Public Sub DoCopy()

Set WB = ThisWorkbook
Set ActWS = WB.ActiveSheet
Set MainWS = WB.Worksheets("Main")

ActWSPreLastRow = ActWS.Cells(ActWS.Rows.Count, "A").End(xlUp).Row
MainWSPreLastRow = MainWS.Cells(MainWS.Rows.Count, "A").End(xlUp).Row

I = MainWSStoredLastRow + (ActWSPreLastRow - ActWSStoredLastRow)

MainWS.Range("A" & MainWSStoredLastRow + 1, "AQ" & I).Value = _
ActWS.Range("A" & ActWSStoredLastRow + 1, "AQ" & ActWSPreLastRow).Value

MainWSPreLastRow = MainWS.Cells(MainWS.Rows.Count, "A").End(xlUp).Row

End Sub

Public Sub StoreOld()
ActWSStoredLastRow = ActWSPreLastRow
MainWSStoredLastRow = MainWSPreLastRow

End Sub

其他工作表

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A5:AQ1000")) Is Nothing Then
    Call StoreOld
    Call DoCopy
End If
End Sub

Answer 1

Microsoft Query 来拯救：

SELECT A,B,C FROM [Sheet1$] 
UNION ALL
SELECT A,B,C FROM [Sheet2$] 

Data->From Other Sources->Microsoft Query 或随意使用my Add-In。

然后在需要时简单地刷新查询（通过 1 行 VBA 或右键单击表并单击刷新）。

详情

假设Sheet1 & Sheet2的结构是：

（输入）数据工作表1（带行号）

 1    |   A   |    B   |   C   |
 2       Cat      Red     Male
 3       Dog     Green   Female

（输入）数据工作表2（带行号）

 1    |   A   |    B   |   C   |
 2     Monkey   Brown    Male
 3       Ant     Blue     Male
 4      Bird     White   Female

那么：

1. 创建新工作表（Sheet3）

2. 使用上述 SQL 创建查询。

如果要添加条件，请将WHERE 子句添加到SELECTs 之一或两者中