EXCEL 活頁簿SHEET1資料分至不同活頁簿

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

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

樓主熱帖

sunnyso

高中生 Rank: 3 Rank: 3

帖子: 605
主題: 92
精華: 0
積分: 648
點名: 0
作業系統: windows
軟體版本: 7
閱讀權限: 50
性別: 男
來自: macau
註冊時間: 2013-4-5
最後登錄: 2019-2-10

熱烈參與勳章好學求知勳章

2^#

發表於 2013-5-2 09:31 | 只看該作者

回復 1# mariabb

不用VBA無法做到

ss

TOP

mariabb

小學生 Rank: 1

帖子: 9
主題: 4
精華: 0
積分: 18
點名: 0
作業系統: VISTA
軟體版本: office 2007
閱讀權限: 10
註冊時間: 2013-4-15
最後登錄: 2013-6-26

3^#

發表於 2013-5-4 14:00 | 只看該作者

那麼, 可否請教VBA如何做呢, 我現正開始學習.

TOP

genes

中學生 Rank: 2

帖子: 45
主題: 1
精華: 0
積分: 51
點名: 0
作業系統: windows 7
軟體版本: office 2003
閱讀權限: 20
註冊時間: 2013-4-16
最後登錄: 2013-12-30

4^#

發表於 2013-5-5 00:34 | 只看該作者

每一活頁簿是一個EXCEL獨立檔

Sub SplitWorkbook()
Dim ws As Worksheet
Dim DisplayStatusBar As Boolean
DisplayStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
Dim NewFileName As String
Application.StatusBar = ThisWorkbook.Sheets.Count & “ Remaining Sheets”
If ThisWorkbook.Sheets.Count <> 1 Then
NewFileName = ThisWorkbook.Path & “\” & ws.Name & “.xlsm” ‘Macro _
-Enabled
‘ NewFileName = ThisWorkbook.Path & “\” & ws.Name & “.xlsx” _
‘Not Macro-Enabled
ws.Copy
ActiveWorkbook.Sheets(1).Name = “Sheet1”
ActiveWorkbook.SaveAs Filename:=NewFileName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
‘ ActiveWorkbook.SaveAs Filename:=NewFileName, _
FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close SaveChanges:=False
Else
NewFileName = ThisWorkbook.Path & “\” & ws.Name & “.xlsm”
‘ NewFileName = ThisWorkbook.Path & “\” & ws.Name & “.xlsx”
ws.Name = “Sheet1”
End If
Next
Application.DisplayAlerts = True
Application.StatusBar = False
Application.DisplayStatusBar = DisplayStatusBar
Application.ScreenUpdating = True
End Sub

複製代碼

TOP

mhl9mhl9

中學生 Rank: 2

帖子: 214
主題: 74
精華: 0
積分: 296
點名: 0
作業系統: win7
軟體版本: office2007
閱讀權限: 20
性別: 男
來自: hk
註冊時間: 2013-6-17
最後登錄: 2018-11-3

5^#

發表於 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

lmh

TOP