Board logo

標題: EXCEL 活頁簿SHEET1資料分至不同活頁簿 [打印本頁]
作者: mariabb    時間: 2013-5-2 07:10     標題: EXCEL 活頁簿SHEET1資料分至不同活頁簿

可否不用VBA, 只用函數或巨集處理下列 ?
(1)
請問有檔案內SHEET1, 內有30名員工資料 (是從人事系統輸出的資料), 已固定每10 ROW為一個員工的資料, 如何將之一次過, 分別儲存至30個不同的EXCEL獨立檔.
即檔案A是陳大文的資料 (來源是活頁簿SHEET1 A1:Z10)
檔案B是李小花的資料 (來源是活頁簿SHEET1 A11:Z21), 如此類推.

(2) 又如何可以快速為每個或一次過將所有獨立檔案:
2A)設定活頁簿防護密碼, 及
2B) 設定檔案開啟密碼?
多謝!
作者: sunnyso    時間: 2013-5-2 09:31

回復 1# mariabb

不用VBA無法做到
作者: mariabb    時間: 2013-5-4 14:00

那麼, 可否請教VBA如何做呢, 我現正開始學習.
作者: genes    時間: 2013-5-5 00:34

每一活頁簿是一個EXCEL獨立檔
  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
複製代碼
作者: mhl9mhl9    時間: 2013-7-13 22:22

回復 1# mariabb

輸出新文件名=A1.xlsm,A11.xlsm,A21.xlsm,A31...
workbook password=123456
workbook open password=123456
workbook 儲存在 thisworkbook所在folder里

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)