请帮忙改下代码，汇总表生成明细表+生成目录链接，不删除其他想保留的表

ping200030

ykcbf1100 发表于 2022-12-1 09:34
其实问题很简单，就是总表汇总时删除了目录表引起的。

解决的方法也简单，就是在汇总时，不删除目录表就 ...

麻烦了，请问总表在标题行增加了一行空白的，明细表怎么生成

1. Private Sub CommandButton1_Click()
   
2.     tms = Timer
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     For Each sht In Sheets
   
6.         If sht.Name <> ActiveSheet.Name And sht.Name <> "目录" Then sht.Delete
   
7.     Next
   
8.     Application.DisplayAlerts = True
   
9.     Set d = CreateObject("scripting.dictionary")
   
10.     arr = Range("a2").CurrentRegion
    
11.     For i = 1 To UBound(arr)
    
12.         If Not d.exists(arr(i, 27)) Then
    
13.             Set d(arr(i, 27)) = Range("a" & i).Resize(1, 66)
    
14.         Else
    
15.             Set d(arr(i, 27)) = Union(d(arr(i, 27)), Range("a" & i).Resize(1, 66))
    
16.         End If
    
17.     Next
    
18.     x = d.keys
    
19.     For k = 1 To UBound(x)
    
20.         Set Sh = ActiveWorkbook.Sheets.Add(, after:=ActiveSheet)
    
21.         Sh.Name = x(k)
    
22.         d.items()(k).Copy Sh.Range("a" & 2)
    
23.         Rows("1:1").Copy Sh.Range("a1")
    
24.     Next
    
25.     Application.ScreenUpdating = True
    
26.     'MsgBox Format(Timer - tms, "拆分完成，共耗时：0.00秒"), 64, "时间统计"
    
27. End Sub
    

复制代码