在线求助，关于排除多个sheet的写法

还是疯子

各位老师早上好，我有一个文档，它里面很多工作表，我找了段代码可以实现将多个工作表汇总到一个里面，如附件的INDEX。


但是随着数量的增加，有部分工作表我不想让它汇总进来，比如SU-LIST以及RG-02，

未来可能还会继续增加不复制的，所以我想请老师帮忙修改一下，如果工作表名称等于“排除复制”工作表里面的名称就不进行汇总。

taller

ykcbf1100

附件供参考。。。

ykcbf1100

代码如下：

1. Sub test()  '//2024.2.27
   
2.     Dim arr, brr(1 To 65536, 1 To 19)
   
3.     Dim x, y, k
   
4.     Set Sh = ThisWorkbook.Sheets("INDEX")
   
5.     With Sheets("排除复制")
   
6.         r = .Cells(Rows.Count, 4).End(3).Row
   
7.         st = ""
   
8.         For i = 3 To r
   
9.             st = st & "|" & UCase(.Cells(i, 4))
   
10.         Next
    
11.         st = st & "|" & Sh.Name & "|" & .Name
    
12.     End With
    
13.     For Each sht In Sheets
    
14.         If InStr(st, sht.Name) = 0 Then
    
15.             arr = sht.UsedRange
    
16.             For x = 5 To UBound(arr)
    
17.                 If arr(x, 2) <> "" Then
    
18.                     k = k + 1
    
19.                     brr(k, 1) = k
    
20.                     For y = 2 To UBound(arr, 2)
    
21.                         brr(k, y) = arr(x, y)
    
22.                     Next
    
23.                 End If
    
24.             Next
    
25.         End If
    
26.     Next
    
27.     Sh.[a2:z1000] = ""
    
28.     Sh.[a2].Resize(k, 16) = brr
    
29.     MsgBox "COPY SUCCESS..."
    
30. End Sub
    

复制代码