用VBA实现，各个分表 复制到 总表（要求，格式，字体，背景，颜色，批注都到总表）

shijin889

图1  怎么实现  图2

zhufeng012

第一次回复帖子，代码如果太丑，不要见怪啊，可以实现你想要的需求；
这个案子比较麻烦的地方是需要带着格式，但是这个格式呢，又是由超级表生成的，所以，需要在超级表的基础上进行拼接；
遇到很多坑啊。代码如下：

1. Option Explicit
   
2. Sub 汇总工作表_带格式()
   
3.    
   
4.     Application.DisplayAlerts = False
   
5.     Application.ScreenUpdating = False
   
6.     Dim ws As Worksheet
   
7.     Dim sr As Long
   
8.     Dim dr As Long
   
9.    
   
10.     Dim a As Long
    
11.     a = Worksheets("汇总表").Range("a1048576").End(3).Row
    
12.     If a > 2 Then
    
13.         Worksheets("汇总表").Rows("2:" & a).Delete
    
14.     End If
    
15.    
    
16.     For Each ws In Worksheets
    
17.         If Right(ws.Name, 1) = "月" Then
    
18.             sr = ws.[A1048576].End(xlUp).Row
    
19.             dr = Worksheets("汇总表").[A1048576].End(xlUp).Row
    
20.             If ws.UsedRange.Rows.Count > 1 Then
    
21.                 ws.Rows("2:" & sr).Copy Worksheets("汇总表").Rows(dr)
    
22.                 Worksheets("汇总表").[A1048576].End(xlUp).ListObject.ListRows.Add AlwaysInsert:=True
    
23.             End If
    
24.         End If
    
25.     Next
    
26.     a = Worksheets("汇总表").[A1048576].End(xlUp).Row
    
27.     Worksheets("汇总表").[A2].ListObject.ListRows(a - 1).Delete
    
28.     Application.CutCopyMode = False
    
29.     Worksheets("汇总表").Range("G2").FormulaR1C1 = "=[@金额]+[@税额]"
    
30.     Worksheets("汇总表").Range("H2").FormulaR1C1 = "=[@税额]/[@金额]"
    
31.     Application.DisplayAlerts = True
    
32.     Application.ScreenUpdating = True
    
33. End Sub

复制代码

具体请看附件吧。

shijin889

zhufeng012 发表于 2019-6-13 15:21
第一次回复帖子，代码如果太丑，不要见怪啊，可以实现你想要的需求；
这个案子比较麻烦的地方是需要带着格 ...

谢谢  非常感谢，可以用，不知道为什么，汇总起来的速度有点慢慢 会转圈圈

shijin889

zhufeng012 发表于 2019-6-13 15:21
第一次回复帖子，代码如果太丑，不要见怪啊，可以实现你想要的需求；
这个案子比较麻烦的地方是需要带着格 ...

谢谢  非常感谢，可以用，不知道为什么，汇总起来的速度有点慢慢 会转圈圈

zhufeng012

我是整行复制粘贴的，想优化的话可以选择区间。

shijin889

zhufeng012 发表于 2019-6-20 09:57
我是整行复制粘贴的，想优化的话可以选择区间。

好的  我试试优化下  谢谢啊