GBKEE

¦^´_ 1# missbb
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Wb As Workbook, E As Variant, xPath As String, i As Integer
   
4.     Set Wb = ThisWorkbook           '¬¡­¶Ã¯ :µ{¦¡½X©Ò¦bªº
   
5.     'Set Wb = Workbooks(2)          '¬¡­¶Ã¯ :²Ä2­Ó
   
6.     'Set Wb = Workbooks("a.xls")    '¬¡­¶Ã¯ :«ü©w¦WºÙ
   
7.     'Set Wb = ActiveWorkbook        '¬¡­¶Ã¯ :§@¥Î¤¤ªº
   
8.     xPath = Wb.Path & "\"                '¦sÀɪº¸ô®|
   
9.     With Wb.Sheets("password")
   
10.         i = 1
    
11.         For Each E In Array("a123", "b456")
    
12.             Wb.Sheets(E).Copy
    
13.             ActiveWorkbook.Sheets(1).UsedRange.Value = ActiveWorkbook.Sheets(1).UsedRange.Value           '¦s¤å¦rªº­È¤Î®æ¦¡
    
14.             ActiveWorkbook.SaveAs Filename:=xPath & E & ".xls", Password:=.Cells(i, "b"), WriteResPassword:=""
    
15.             ActiveWorkbook.Close False
    
16.         Next
    
17.         i = i + 1
    
18.     End With
    
19. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 3# missbb

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Wb As Workbook, E As Variant, xPath As String, I As Integer
   
4.     Set Wb = ThisWorkbook          '¬¡­¶Ã¯ :µ{¦¡½X©Ò¦bªº
   
5.     'Set Wb = Workbooks(2)          '¬¡­¶Ã¯ :²Ä2­Ó
   
6.     'Set Wb = Workbooks("a.xls")  '¬¡­¶Ã¯ :«ü©w¦WºÙ
   
7.     'Set Wb = ActiveWorkbook      '¬¡­¶Ã¯ :§@¥Î¤¤ªº
   
8.     xPath = Wb.Path & "\"            '¦sÀɪº¸ô®|
   
9.     With Wb.Sheets("password")
   
10.         '*********³o¬¡­¶Ã¯¦³20­Ó¤u§@ªí+"password"*************************************************
    
11.         For I = 1 To Wb.Sheets.Count - 1 'password ¤u§@ªí ©T©w¬¡­¶Ã¯¤¤¦ì¸m³Ì«á­±(©Ò¦³¤u§@ªíªº«á­±)
    
12.         ' For i = 2 To Wb.Sheets.Count     'password ¤u§@ªí ©T©w¬¡­¶Ã¯¤¤¦ì¸m³Ì«e­±(²Ä1­Ó)
    
13.         '*********³o¬¡­¶Ã¯¤£¥u¦³20­Ó¤u§@ªí+"password" -> ¬¡­¶Ã¯¤¤20­Ó¤u§@ªí¬O³sÄò¦b¦p(5-24)ªº¯Á¤Þ¦ì¸m**************
    
14.         ' For i = 5 To 24
    
15.         '********************************************************************************************
    
16.             Wb.Sheets(I).Copy
    
17.             ActiveWorkbook.Sheets(1).UsedRange.Value = ActiveWorkbook.Sheets(1).UsedRange.Value           '¦s¤å¦rªº­È¤Î®æ¦¡
    
18.             ActiveWorkbook.SaveAs Filename:=xPath & Wb.Sheets(I).Name & ".xls", Password:=Trim(.Cells(I, "b")), WriteResPassword:=""
    
19.                        '·í For i = 1  ->  Password:=Trim(.Cells(i, "b"))
    
20.                        '·í For i = 2  ->  Password:=Trim(.Cells(i - 1, "b"))
    
21.                        '·í For i = 3  ->  Password:=Trim(.Cells(i - WB.Sheets(3).Index + 1, "b"))
    
22.                        '·í For i = 4  ->  Password:=Trim(.Cells(i - WB.Sheets(4).Index + 1, "b"))
    
23.                         '±K½X·|¿ù»~,¥i¯à¬O«e«á¦³ªÅ¥Õ¦r¤¸ ,Trim:®ø°£«e«áªÅ¥Õ¦r¤¸ ->   Password:=Trim(.Cells(i, "b"))
    
24.             ActiveWorkbook.Close False
    
25.         Next
    
26.     End With
    
27. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 6# missbb

1. Sub ex()
   
2. Dim f$, fd$, fs$, A As Range, Wb As Workbook
   
3.     Set Wb = ThisWorkbook          '¬¡­¶Ã¯ :µ{¦¡½X©Ò¦bªº
   
4.     'Set Wb = Workbooks(2)          '¬¡­¶Ã¯ :²Ä2­Ó
   
5.     'Set Wb = Workbooks("a.xls")  '¬¡­¶Ã¯ :«ü©w¦WºÙ
   
6.     'Set Wb = ActiveWorkbook      '¬¡­¶Ã¯ :§@¥Î¤¤ªº
   
7.     fd = "D:\"
   
8.     With Wb.Sheets("PASSWORD")
   
9.         For Each A In .Range(.[A1], .[A1].End(xlDown))
   
10.         f = CStr(A)
    
11.         fs = fd & f & ".xls"
    
12.         Wb.Sheets(f).Copy
    
13.         '¦p¦³¦h­Ó¬¡­¶Ã¯±Ò®É,¥BActiveWorkbook,¤£¬O­n½Æ»s¤u§@ªíªº¬¡­¶Ã¯.
    
14.         '«ü©w¬O­þ¤@­Ó¬¡­¶Ã¯ªº¤u§@ªí­n½Æ»s
    
15.         With ActiveWorkbook
    
16.             .ActiveSheet.UsedRange = .ActiveSheet.UsedRange.Value
    
17.             .SaveAs Filename:=fs, Password:=CStr(A.Offset(, 1)), WriteResPassword:=""
    
18.             .Close 0
    
19.         End With
    
20.     Next
    
21.     End With
    
22. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 22# missbb

1. Option Explicit
   
2. Sub Ex2()            '  Hsieh & GBKEE
   
3.     Dim f$, fd$, fs$, A As Range, Wb As Workbook, AR()
   
4.     Set Wb = ThisWorkbook             '  ¬¡­¶Ã¯ :µ{¦¡½X©Ò¦bªº
   
5.     fd = Wb.Path & "\"                       '  ¦sÀɪº¸ô®|
   
6.     Application.DisplayAlerts = False
   
7.     Application.ScreenUpdating = False
   
8.     With Wb.Sheets("PASSWORD")
   
9.         For Each A In .Range(.[A2], .[A2].End(xlDown))
   
10.             f = CStr(A)
    
11.             fs = fd & f & ".xls"
    
12.             AR = Wb.Sheets(f).UsedRange.Value
    
13.             With Workbooks.Add(1)
    
14.                 .ActiveSheet.Range("A1").Resize(UBound(AR, 1), UBound(AR, 2)) = AR
    
15.                 '  FileFormat:=xlExcel8   Excel 2003ª©¥» 56; xlExcel12  version 12, or 14, or 15 = Excel 2007, or 2010, or 2013.
    
16.                
    
17.                 .SaveAs Filename:=fs, Password:=CStr(A.Offset(, 1)), WriteResPassword:="" , FileFormat:=xlExcel8
    
18.                 .Close 0       '  Ãö³¬ "D:\A123.xls" ¬¡­¶Ã¯¡B"D:\B456.xls" ¬¡­¶Ã¯¡C
    
19.             End With           '  ¥¿¦¡µ²§ô (Ãö³¬)¡C
    
20.         Next
    
21.     End With
    
22.     Application.DisplayAlerts = True
    
23.     Application.ScreenUpdating = True
    
24. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 26# missbb
2003´ú¸Õ »Ýµù¸ÑFileFormat:=xlExcel8
¤w§ó¥¿ ¨ú®øµù¸Ñ ' FileFormat:=xlExcel8

GBKEE

¦^´_ 32# missbb
¥u­n§A»{¬°¬¡­¶Ã¯©|¥¼«OÅ@®É³£¥i¥Îªº

1. '«OÅ@¬¡­¶Ã¯¨Ï¨ä¤£³Q­×§ï¡C
   
2. ActiveWorkbook.Protect Password:="9999", structure:=True, Windows:=True

½Æ»s¥N½X

GBKEE

¦^´_ 35# missbb

1. Option Explicit
   
2. Sub Ex2()
   
3.     Dim f$, fd$, fs$, A As Range, Wb As Workbook
   
4.     Set Wb = ThisWorkbook             '  ¬¡­¶Ã¯ :µ{¦¡½X©Ò¦bªº
   
5.     fd = Wb.Path & "\"                       '  ¦sÀɪº¸ô®|
   
6.     Application.DisplayAlerts = False
   
7.     Application.ScreenUpdating = False
   
8.     With Wb.Sheets("PASSWORD")
   
9.         For Each A In .Range(.[A2], .[A2].End(xlDown))
   
10.             f = CStr(A)
    
11.             fs = fd & f & ".xls"
    
12.             Wb.Sheets(f).UsedRange.Copy  '¥ÎCOPY
    
13.             With Workbooks.Add(1)
    
14.                 With .Sheets(1).Range("A1")
    
15.                     .PasteSpecial xlPasteValues           '¶K¤W­È
    
16.                     .PasteSpecial xlPasteColumnWidths     '¶K¤WÄæ¼e
    
17.                     .PasteSpecial xlPasteFormats          '¶K¤W®æ¦¡
    
18.                     '²Ä¤@­«:«OÅ@¤u§@ªí
    
19.                     .Parent.Protect Password:="9999", DrawingObjects:=True, Contents:=True, Scenarios:=True
    
20.                 End With
    
21.                 '²Ä¤G­«:«OÅ@¬¡­¶Ã¯¨Ï¨ästructure(µ²ºc:¤u§@ªí¤£¥i§R¼W)¡C
    
22.                 .Protect Password:="9999", structure:=True, Windows:=False
    
23.                 '  FileFormat:=xlExcel8   Excel 2003ª©¥» 56; xlExcel12  version 12, or 14, or 15 = Excel 2007, or 2010, or 2013.
    
24.                 '²Ä¤T­«: ­­¨î¨Ï¥ÎªÌ
    
25.                 .SaveAs Filename:=fs, Password:=CStr(A.Offset(, 1)), WriteResPassword:=""   , FileFormat:=xlExcel8
    
26.                 .Close 0   '  Ãö³¬  "D:\A123.xls" ¬¡­¶Ã¯¡B"D:\B456.xls" ¬¡­¶Ã¯¡C
    
27.             End With           '  ¥¿¦¡µ²§ô (Ãö³¬)¡C
    
28.         Next
    
29.     End With
    
30.     Application.DisplayAlerts = True
    
31.     Application.ScreenUpdating = True
    
32. End Sub

½Æ»s¥N½X