返回列表 上一主題 發帖

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

mariabb

帖子
9 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
VISTA 
軟體版本
office 2007 
閱讀權限
10 
註冊時間
2013-4-15 
最後登錄
2013-6-26 
1# 跳轉到 » 正序看帖
打印
tT
發表於 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) 設定檔案開啟密碼?
多謝!
收藏 分享

mhl9mhl9

帖子
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

genes

帖子
45 
主題
1 
精華
0 
積分
51 
點名
0  
作業系統
windows 7 
軟體版本
office 2003 
閱讀權限
20 
註冊時間
2013-4-16 
最後登錄
2013-12-30 
4#
發表於 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
複製代碼

TOP

mariabb

帖子
9 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
VISTA 
軟體版本
office 2007 
閱讀權限
10 
註冊時間
2013-4-15 
最後登錄
2013-6-26 
3#
發表於 2013-5-4 14:00 | 只看該作者
那麼, 可否請教VBA如何做呢, 我現正開始學習.

TOP

sunnyso

帖子
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

        靜思自在 : 真正的愛心，是照顧好自己的這顆心。
返回列表 上一主題