实时将来自多个工作表的数据组合到摘要工作表中-Realtimecombinedatafrommultipleworksheetsintoasummaryworksheet

I have data in multiple Data worksheets that want to combine into Summary worksheet. When user update data in any Data worksheet, it will copy information automatically to Summary worksheet.

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

For example

(Input) Data worksheet1

(输入)数据工作表1

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

(Input) Data worksheet2

(输入)数据工作表2

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

(Output) Summary Worksheet

(输出)摘要工作表

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

Right now my code running okay with one data worksheet. But when I try to switch to work on another data worksheet, the data on summary worksheet will not correct. It also has some errors when I delete all information or when I change the code (I need to reopen it).

现在我的代码运行正常,有一个数据工作表。但是,当我尝试切换到另一个数据工作表上的工作时,摘要工作表上的数据将无法更正。当我删除所有信息或更改代码时(我需要重新打开它),它也有一些错误。

Here is my code

这是我的代码

ThisWorkBook

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

Module

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

Other worksheets

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

1 个解决方案

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

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

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