求大神帮忙：如何能将多个不同工作表的内容，自动同步汇总到一个总表中

lgaying

各位大神，想把产品A和产品B工作表中的数据，汇总到汇总表中。如果产品A和产品B中的数据发生（添加新记录或修改）变化，汇总表中自动添加或修改，这个该怎么实现呢？

feiren228

Sub 汇总()
    Dim arr, r&, sh As Worksheet
    Sheets("汇总").UsedRange.Offset(1).ClearContents
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "汇总" Then
            With sh
                r = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row '计算工作表最后一个非空行号
                arr = .[a2].Resize(r - 1, 4)
            End With
            With Sheets("汇总")
                r = .Range("A:A").Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row '计算工作表最后一个非空行号
                .Cells(1, 1).Offset(r).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
            End With
        End If
    Next
End Sub

feiren228

1. Sub 汇总()
   
2.     Dim arr, r&, sh As Worksheet
   
3.     Sheets("汇总").UsedRange.Offset(1).ClearContents
   
4.     For Each sh In ThisWorkbook.Worksheets
   
5.         If sh.Name <> "汇总" Then
   
6.             With sh
   
7.                 r = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row '计算工作表最后一个非空行号
   
8.                 arr = .[a2].Resize(r - 1, 4)
   
9.             End With
   
10.             With Sheets("汇总")
    
11.                 r = .Range("A:A").Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row '计算工作表最后一个非空行号
    
12.                 .Cells(1, 1).Offset(r).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    
13.             End With
    
14.         End If
    
15.     Next
    
16. End Sub
    

复制代码

feiren228

Sub 汇总()
    Dim arr, r&, sh As Worksheet
    Sheets("汇总").UsedRange.Offset(1).ClearContents
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "汇总" Then
            With sh
                r = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row '计算工作表最后一个非空行号
                arr = .[a2].Resize(r - 1, 4)
            End With
            With Sheets("汇总")
                r = .Range("A:A").Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row '计算工作表最后一个非空行号
                .Cells(1, 1).Offset(r).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
            End With
        End If
    Next
End Sub

iwangyi

Sub 汇总()
N = [A65536].End(3).Row
Sheets("产品A").UsedRange.Offset(1).Copy Cells(N + 1, 1)
N = [A65536].End(3).Row
Sheets("产品B").UsedRange.Offset(1).Copy Cells(N + 1, 1)
End Sub

iwangyi

附件**************

iwangyi

产品A 表数据改动更新

Private Sub Worksheet_Change(ByVal Target As Range)
With Sheets("汇总")
Sheets("汇总").UsedRange.Offset(1).Clear
N = .[A65536].End(3).Row
Sheets("产品A").UsedRange.Offset(1).Copy .Cells(N + 1, 1)
N = .[A65536].End(3).Row
Sheets("产品B").UsedRange.Offset(1).Copy .Cells(N + 1, 1)
End With
End Sub

iwangyi

产品B表 数据变动更新总表的代码与产品A 相同 附件如下
请参考

opiona

http://club.excelhome.net/thread-1409141-1-1.html