返回列表 上一主題 發帖

[發問] VBA另存新檔出錯

准提部林

帖子
2808 
主題
10 
精華
0 
積分
2864 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-5-19 
1# 跳轉到 »
發表於 2024-1-27 11:22 | 顯示全部帖子
Sub activeSave_2c()
Dim filename As String, fPath As String,k%, km$
Application.ScreenUpdating = False
filename = [S2]: fPath = [S3]
If Dir(fPath, vbDirectory) = "" Then MkDir fPath

for k = 99 to 1 step -1
     km="_V" & format(k, "00")
     If Dir(fPath & "\" & filename & km & ".xlsx") <> "" Then exit for
next k
if k>=99 then msgbox "檔案序號已用完!!  ":exit sub
km="_V" & format(k+1, "00")

ActiveSheet.Copy
[A1:G100].Value = [A1:G100].Value
[H:Y].Delete: [A1].Select
ActiveWorkbook.SaveAs filename:=fPath & "\" & filename & km & ".xlsx"
ActiveWorkbook.Close
MsgBox "已經新增檔案": ThisWorkbook.Activate

TOP

准提部林

帖子
2808 
主題
10 
精華
0 
積分
2864 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-5-19 
2#
發表於 2024-1-27 11:27 | 顯示全部帖子
檔名+日期時間//更符合分次建檔

Sub activeSave_3c()
Dim filename As String, fPath As String,k%, km$
Application.ScreenUpdating = False
filename = [S2]: fPath = [S3]
If Dir(fPath, vbDirectory) = "" Then MkDir fPath

km="_V" & format(now, "yymmdd-hhmmss")

ActiveSheet.Copy
[A1:G100].Value = [A1:G100].Value
[H:Y].Delete: [A1].Select
ActiveWorkbook.SaveAs filename:=fPath & "\" & filename & km & ".xlsx"
ActiveWorkbook.Close
MsgBox "已經新增檔案": ThisWorkbook.Activate

TOP

        靜思自在 : 願要大、志要堅、氣要柔、心要細。
返回列表 上一主題