合并sheet代码如何修订

WZP4561

大侠，顺便再请教下，若我后面还要增加很多张sheet, 程序如何修改，我刚刚试了下，前3张sheet没问题，但复制新增的sheet，其中主要问题是，我在分表中减少项目后，总表中不能自动去除！


具体见附件，谢谢！

3190496160

3190496160

松永

在处理后保存时更改汇总行不？

WZP4561

3190496160 发表于 2024-12-24 09:57

为何复制你的代码，调试会出现找不到对象，谢谢

3190496160

WZP4561 发表于 2024-12-24 10:57
为何复制你的代码，调试会出现找不到对象，谢谢

代码没有抄写完整或者抄写错误吧，没有测试好的代码是不会给你的

WZP4561

3190496160 发表于 2024-12-24 11:17
代码没有抄写完整或者抄写错误吧，没有测试好的代码是不会给你的

好的，另我想在“汇总表”前的sheet不纳入汇总，后面的纳入汇总，如图。代码又如何实现，能否传递个附件，以便学习，谢谢！

ykcbf1100

新写一个

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub 多表合并()            '//2024.12.24
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim arr, brr(1 To 10000, 1 To 100)
   
5.     For Each sht In Sheets
   
6.         If InStr(sht.Name, "厂") Then
   
7.             With sht
   
8.                 r = .Cells(Rows.Count, 1).End(3).Row
   
9.                 c = .UsedRange.Columns.Count
   
10.                 arr = .[a1].Resize(r, c)
    
11.                 bt = .Columns(1).Find("序号").Row
    
12.             End With
    
13.             For i = bt + 1 To UBound(arr)
    
14.                 If Val(arr(i, 1)) Then
    
15.                     m = m + 1
    
16.                     brr(m, 1) = m
    
17.                     For j = 2 To UBound(arr, 2)
    
18.                         brr(m, j) = arr(i, j)
    
19.                     Next j
    
20.                 End If
    
21.             Next i
    
22.         End If
    
23.     Next
    
24.     With Sheets("汇总表")
    
25.         .UsedRange.Offset(3).ClearContents
    
26.         .[a4].Resize(m, c) = brr
    
27.     End With
    
28.     Application.ScreenUpdating = True
    
29.     MsgBox "OK！"
    
30. End Sub
    

复制代码

wcj6376tcp

WZP4561 发表于 2024-12-24 11:38
好的，另我想在“汇总表”前的sheet不纳入汇总，后面的纳入汇总，如图。代码又如何实现，能否传递个附件 ...

人家if不是给你判断筛选了吗？你自己修改一下啊 if sh.name like "*工厂"  then