[求助]excel文件根据某一列拆分成多个工作表/工作簿并分别设置不同密码

ykcbf1100

一表拆分为多工作簿，工作簿加密码

ykcbf1100

拆分为多工作簿，

1. Sub ykcbf()  '//2024.2.9
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     Dim tm: tm = Timer
   
7.     p = ThisWorkbook.Path & ""
   
8.     arr = Sheets("密码").UsedRange
   
9.     For i = 2 To UBound(arr)
   
10.         d1(arr(i, 1)) = arr(i, 2)
    
11.     Next
    
12.     Set sh = ThisWorkbook.Sheets("数据")
    
13.     arr = sh.UsedRange
    
14.     For i = 2 To UBound(arr)
    
15.         s = arr(i, 2)
    
16.         If Not d.Exists(s) Then
    
17.             Set d(s) = CreateObject("scripting.dictionary")
    
18.         End If
    
19.         d(s)(i) = i
    
20.     Next i
    
21.     For Each k In d.keys
    
22.         sh.Copy
    
23.         Set wb = ActiveWorkbook
    
24.         Set sht = wb.Sheets(1)
    
25.         m = 0
    
26.         ReDim brr(1 To d(k).Count, 1 To 4)
    
27.         With sht
    
28.             .Name = k
    
29.             .DrawingObjects.Delete

复制代码

参与一下。。。

慢慢来不急

ykcbf1100 发表于 2024-2-9 11:45
一表拆分为多表，工作表加密码保护，附件供参考。。。

新年好~
刚试了一下，这个宏可以快速拆分成多个工作表，但是新拆分的工作表没有加密保护，不知道是我哪里操作有问题么？

ykcbf1100

慢慢来不急 发表于 2024-2-18 09:24
新年好~
刚试了一下，这个宏可以快速拆分成多个工作表，但是新拆分的工作表没有加密保护，不知道是我哪 ...

我这里正常的，工作表有密码保护。