- 帖子
- 258
- 主題
- 77
- 精華
- 0
- 積分
- 385
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 20
- 性別
- 男
- 來自
- Taiwan
- 註冊時間
- 2010-8-8
- 最後登錄
- 2021-1-25
|
回復 7# yangjie
感謝GBKEE
我參考這次與前13.14頁的檔案複製與sheets另存新檔
我的問題解決了
Sub Backup()
Dim FileName1 As String
Set wb = ThisWorkbook
wb.Activate
Dim str1 As String
Dim ar() As String
n = Sheets("基本資料").Cells(1, 60).End(xlToLeft).Column - 5
If n <= 0 Then Exit Sub
ReDim ar(n)
For i = 1 To n
ar(i - 1) = Sheets("基本資料").Cells(1, i + 5)
Next
str1 = Sheets("基本資料").Cells(1, 1) & Sheets("基本資料").Cells(1, 2)
If MsgBox("要備份資料嗎?", vbYesNo + vbQuestion, "訊息視窗") = vbYes Then
Application.DisplayAlerts = False
For i = 1 To n
FileName1 = ThisWorkbook.Path & "\" & str1 & "學期(" & ar(i - 1) & ")出缺勤暨獎懲登錄.xls"
With ActiveWorkbook
ActiveWorkbook.SaveCopyAs FileName:=FileName1 '漂亮
End With
Next
Else
MsgBox "再見 !", vbOKOnly + vbInformation, "訊息視窗"
End If
Application.DisplayAlerts = True
End Sub |
|