多个工作表合并

jier007333

各位大神，
      求助一下！
      需要将多个工作表（每次约20+个）合并到一起统计每个月的出货量，仅需要简单汇总，请各位帮忙，感谢！

      附件修改了一下， 最后是想要合并成附件中第一个“汇总”工作表的结果！

LIUZHU

如果只是简单汇总的话，没什么难度，不过表格也不是很规范，另外合并后也没有标记是来自于合并前哪一张分表

jier007333

LIUZHU 发表于 2024-5-23 10:37
如果只是简单汇总的话，没什么难度，不过表格也不是很规范，另外合并后也没有标记是来自于合并前哪一张分表

老师，
    你好！
    只是需要简单的汇总，不需要标记来源。创建一个新的汇总sheet就可以。附件表头一致，但表格数量较多，请帮忙写个程序！本人VBA完全不懂

ykcbf1100

分表数据不规范，难搞啊，尽力了。

ykcbf1100

参与一下。。。

1. Sub 多表合并()  '//2024.5.23
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set sh = ThisWorkbook.Sheets("汇总表")
   
5.     sh.Cells.Clear
   
6.     On Error Resume Next
   
7.     For Each sht In Sheets
   
8.         If sht.Name <> sh.Name Then
   
9.             If sht.Visible = -1 Then
   
10.                 With sht
    
11.                     .AutoFilterMode = False
    
12.                         m = m + 1
    
13.                         If m = 1 Then
    
14.                             .Cells.Copy sh.Cells(1, 1)
    
15.                         Else
    
16.                             r = sh.UsedRange.Rows.Count
    
17.                             r1 = .UsedRange.Find("总计").Row
    
18.                             .Rows(4 & ":" & r1 - 1).Copy
    
19.                             sh.Cells(IIf(m = 2, r, r + 1), 1).PasteSpecial Paste:=xlPasteAll
    
20.                             sh.Cells(IIf(m = 2, r, r + 1), 1).PasteSpecial Paste:=xlPasteValues
    
21.                         End If
    
22.                 End With
    
23.             End If
    
24.         End If
    
25.     Next
    
26.     Application.ScreenUpdating = True
    
27.     MsgBox "OK！"
    
28. End Sub
    

复制代码

jier007333

ykcbf1100 发表于 2024-5-23 11:39
分表数据不规范，难搞啊，尽力了。

老师：
      非常感谢您的回复，把代码用在我工作的表上，运行出现错误，麻烦您再帮忙修改一下！

ykcbf1100

jier007333 发表于 2024-5-23 11:52
老师：
      非常感谢您的回复，把代码用在我工作的表上，运行出现错误，麻烦您再帮忙修改一下！

上传附件吧。

jier007333

ykcbf1100 发表于 2024-5-23 12:57
上传附件吧。

老师，1楼附件已修改，最后想要合并成附件中的“汇总”，请大神帮忙！

ykcbf1100

jier007333 发表于 2024-5-23 14:16
老师，1楼附件已修改，最后想要合并成附件中的“汇总”，请大神帮忙！

那就这样了。

ykcbf1100

代码更新一下。

1. Sub 多表合并()  '//2024.5.23
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set sh = ThisWorkbook.Sheets("汇总表")
   
5.     sh.Cells.Clear
   
6.     On Error Resume Next
   
7.     For Each sht In Sheets
   
8.         If sht.Name <> sh.Name Then
   
9.             If sht.Visible = -1 Then
   
10.                 With sht
    
11.                     .AutoFilterMode = False
    
12.                     m = m + 1
    
13.                     If m = 1 Then
    
14.                         .Cells.Copy sh.Cells(1, 1)
    
15.                     Else
    
16.                         r = sh.Cells(Rows.Count, 2).End(3).Row
    
17.                         r1 = .UsedRange.Find("总计").Row
    
18.                         .Rows(2 & ":" & r1).Copy sh.Cells(r + 1, 1)
    
19.                     End If
    
20.                 End With
    
21.             End If
    
22.         End If
    
23.     Next
    
24.     Application.ScreenUpdating = True
    
25.     MsgBox "OK！"
    
26. End Sub
    

复制代码