ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

EXCEL ¬¡­¶Ã¯SHEET1¸ê®Æ¤À¦Ü¤£¦P¬¡­¶Ã¯

EXCEL ¬¡­¶Ã¯SHEET1¸ê®Æ¤À¦Ü¤£¦P¬¡­¶Ã¯

¥i§_¤£¥ÎVBA, ¥u¥Î¨ç¼Æ©Î¥¨¶°³B²z¤U¦C ?
(1)
½Ð°Ý¦³ÀɮפºSHEET1, ¤º¦³30¦W­û¤u¸ê®Æ (¬O±q¤H¨Æ¨t²Î¿é¥Xªº¸ê®Æ), ¤w©T©w¨C10 ROW¬°¤@­Ó­û¤uªº¸ê®Æ, ¦p¦ó±N¤§¤@¦¸¹L, ¤À§OÀx¦s¦Ü30­Ó¤£¦PªºEXCEL¿W¥ßÀÉ.
§YÀÉ®×A¬O³¯¤j¤åªº¸ê®Æ (¨Ó·½¬O¬¡­¶Ã¯SHEET1 A1:Z10)
ÀÉ®×B¬O§õ¤pªáªº¸ê®Æ (¨Ó·½¬O¬¡­¶Ã¯SHEET1 A11:Z21), ¦p¦¹Ãþ±À.

(2) ¤S¦p¦ó¥i¥H§Ö³t¬°¨C­Ó©Î¤@¦¸¹L±N©Ò¦³¿W¥ßÀÉ®×:
2A)³]©w¬¡­¶Ã¯¨¾Å@±K½X, ¤Î
2B) ³]©wÀɮ׶}±Ò±K½X?
¦hÁÂ!

¦^´_ 1# mariabb

¿é¥X·s¤å¥ó¦W=A1.xlsm,A11.xlsm,A21.xlsm,A31...
workbook password=123456
workbook open password=123456
workbook Àx¦s¦b thisworkbook©Ò¦bfolder¨½

Sub CreatePrivateWB()
    Do
        Set R = Cells(1, 1).Offset(10 * p).Resize(10, 26)
        A = R.Value
        If WorksheetFunction.CountA(A) > 0 Then
            R.Copy
            Set Wb = Workbooks.Add
            With Wb
                Name = R.Cells(1).Address(False, False, xlA1)
                Cells(1, 1).PasteSpecial
                .Protect 123456
                .SaveAs Filename:=ThisWorkbook.Path & "\" & Name & ".xlsm", _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:=123456
                .Close True
            End With
            p = p + 1
        Else
            Exit Sub
        End If
    Loop
End Sub
lmh

TOP

¨C¤@¬¡­¶Ã¯¬O¤@­ÓEXCEL¿W¥ßÀÉ
  1. Sub SplitWorkbook()
  2. Dim ws As Worksheet
  3. Dim DisplayStatusBar As Boolean
  4. DisplayStatusBar = Application.DisplayStatusBar
  5. Application.DisplayStatusBar = True
  6. Application.ScreenUpdating = False
  7. Application.DisplayAlerts = False
  8. For Each ws In ThisWorkbook.Sheets
  9. Dim NewFileName As String
  10. Application.StatusBar = ThisWorkbook.Sheets.Count & ¡§ Remaining Sheets¡¨
  11. If ThisWorkbook.Sheets.Count <> 1 Then
  12. NewFileName = ThisWorkbook.Path & ¡§\¡¨ & ws.Name & ¡§.xlsm¡¨ ¡¥Macro _
  13. -Enabled
  14. ¡¥ NewFileName = ThisWorkbook.Path & ¡§\¡¨ & ws.Name & ¡§.xlsx¡¨ _
  15. ¡¥Not Macro-Enabled
  16. ws.Copy
  17. ActiveWorkbook.Sheets(1).Name = ¡§Sheet1¡¨
  18. ActiveWorkbook.SaveAs Filename:=NewFileName, _
  19. FileFormat:=xlOpenXMLWorkbookMacroEnabled
  20. ¡¥ ActiveWorkbook.SaveAs Filename:=NewFileName, _
  21. FileFormat:=xlOpenXMLWorkbook
  22. ActiveWorkbook.Close SaveChanges:=False
  23. Else
  24. NewFileName = ThisWorkbook.Path & ¡§\¡¨ & ws.Name & ¡§.xlsm¡¨
  25. ¡¥ NewFileName = ThisWorkbook.Path & ¡§\¡¨ & ws.Name & ¡§.xlsx¡¨
  26. ws.Name = ¡§Sheet1¡¨
  27. End If
  28. Next
  29. Application.DisplayAlerts = True
  30. Application.StatusBar = False
  31. Application.DisplayStatusBar = DisplayStatusBar
  32. Application.ScreenUpdating = True
  33. End Sub
½Æ»s¥N½X

TOP

¨º»ò, ¥i§_½Ð±ÐVBA¦p¦ó°µ©O, §Ú²{¥¿¶}©l¾Ç²ß.

TOP

¦^´_ 1# mariabb

¤£¥ÎVBAµLªk°µ¨ì
ss

TOP

        ÀR«ä¦Û¦b : Ãø¦æ¯à¦æ¡AÃø±Ë¯à±Ë¡AÃø¬°¯à¬°¡A¤~¯àª@µØ¦Û§Úªº¤H®æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD