工作表另存新檔和以儲存格內容命名

帖子: 216
主題: 71
精華: 0
積分: 292
點名: 0
作業系統: window xp
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-6-27
最後登錄: 2024-9-28

3^#

發表於 2023-12-5 13:48 | 只看該作者

回復 2# Andy2483

多謝指道, :'(

帖子: 216
主題: 71
精華: 0
積分: 292
點名: 0
作業系統: window xp
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-6-27
最後登錄: 2024-9-28

4^#

發表於 2023-12-5 13:53 | 只看該作者

回復 3# missbb

想再多問, 如果在工作表設定了列印範圍(工作表1和2或有不同) , 另存新檔時不想顯示欄F 的路徑和檔案名字, 應在VBA CODE內那裡修改?

拜託指導

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

5^#

發表於 2023-12-5 14:16 | 只看該作者

本帖最後由 Andy2483 於 2023-12-5 14:37 編輯

回復 4# missbb

謝謝前輩回復,修改如下,請前輩參考
列印範圍(工作表1和2或有不同):經測試原工作表列印範圍會帶到新複製的設定

Option Explicit
Sub TEST()
Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Dim A, Z, i&, T$, T1$, T2$, F1 As Range, F2 As Range
Set Z = CreateObject("Scripting.Dictionary")
T1 = "另存檔案路徑": T2 = "另存檔案名稱"
For i = 1 To Worksheets.Count
Set F1 = Sheets(i).[1:1].Find(T1, Lookat:=xlWhole)
Set F2 = Sheets(i).[2:2].Find(T2, Lookat:=xlWhole)
If F1 Is Nothing Or F2 Is Nothing Then GoTo i01 Else T = F2(1, 2) & "/S"
If Z(T) <> "" Then MsgBox F2(1, 2) & " 檔名重複,請檢查": Exit Sub
Z(T) = F1(1, 2) & "": Set Z(F2(1, 2) & "") = Sheets(i): Z(F2(1, 2) & "/a") = F1.Address
i01: Next
For Each A In Z.KEYS
If Not IsObject(Z(A)) Then GoTo A01 Else T = Z(A & "/S")
Z(A).Copy: If Dir(T, vbDirectory) = "" Then MkDir T
With ActiveSheet.UsedRange: .Value = .Value: End With
Range(Z(A & "/a")).Resize(2, 2) = ""
With ActiveWorkbook: .SaveAs Filename:=T & "\" & A: .Close: End With
ThisWorkbook.Activate
A01: Next
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

帖子: 216
主題: 71
精華: 0
積分: 292
點名: 0
作業系統: window xp
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-6-27
最後登錄: 2024-9-28

6^#

發表於 2023-12-5 22:44 | 只看該作者

回復 5# Andy2483

非常感謝!

帖子: 216
主題: 71
精華: 0
積分: 292
點名: 0
作業系統: window xp
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-6-27
最後登錄: 2024-9-28

7^#

發表於 2023-12-6 00:03 | 只看該作者

本帖最後由 missbb 於 2023-12-6 00:04 編輯

回復 missbb

謝謝前輩回復,修改如下,請前輩參考
列印範圍(工作表1和2或有不同):經測試原工作表 ...
Andy2483 發表於 2023-12-5 14:16

你好 , 一直在試用 , 現時可是將全部工作表2,工作表3和工作表4另存為新的WORKBOOK. 但如果只要工作表2和工作表4另存WORKSBOOK (又或是只另存工作表4等不同情況), 可否用INPUT BOX輸入來制作? :(

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

8^#

發表於 2023-12-6 07:00 | 只看該作者

回復 7# missbb

謝謝前輩再指教
1.部分另存的意義為何?
另存的目標資料夾位置都一樣,即使是部分另存,這些另存檔還是混同一資料夾裡,取用一樣需要在檔案總管挑選,所以部分另存會變得意義不大,這是會有此疑問的原因

2.或說明這些另存的用途.另存頻率....等

3.如果只是列印後另存,可參考以下鏈結帖
https://forum.twbts.com/viewthre ... mp;page=2#pid122046

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

帖子: 216
主題: 71
精華: 0
積分: 292
點名: 0
作業系統: window xp
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-6-27
最後登錄: 2024-9-28

9^#

發表於 2023-12-6 19:30 | 只看該作者

回復 8# Andy2483

因為工作需要，未必每次都要另存所有工作表。我會參照你提供的資料再試，非常感謝:)

singo1232001

　暱稱: 熱狗慶

帖子: 354
主題: 5
精華: 0
積分: 387
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-8-2

論壇榮譽勳章論壇贊助勳章

10^#

發表於 2023-12-8 03:06 | 只看該作者

本帖最後由 singo1232001 於 2023-12-8 03:07 編輯

回復 9# missbb

Sub 同資料夾導出()

Set outSh = ActiveSheet
Set myBook = ThisWorkbook

Filename = outSh.[G2].Value & " " & Format(Now, "yyyyMMdd_HHnnss") & ".xlsx"
' 設定檔案保存路徑（更改為所需路徑）
filePath = myBook.Path & "\" & Filename

outSh.Copy
Set NewWorkbook = ActiveWorkbook
' 保存新工作簿
NewWorkbook.SaveAs Filename:=filePath
End Sub

Sub G1G2另存路徑導出()

Set outSh = ActiveSheet
Set myBook = ThisWorkbook

Filename = outSh.[G2].Value & " " & Format(Now, "yyyyMMdd_HHnnss") & ".xlsx"
' 設定檔案保存路徑（更改為所需路徑）
filePath = Range("G1").Value & "\" & Filename

outSh.Copy
Set NewWorkbook = ActiveWorkbook
' 保存新工作簿
NewWorkbook.SaveAs Filename:=filePath
End Sub

Sub 資料選擇器路徑導出()

Set fd = Excel.Application.FileDialog(msoFileDialogFolderPicker)  '設定選取檔案功能
fd.InitialFileName = Excel.ActiveWorkbook.Path  '設定預設目錄
fd.Show '顯示對話框
If fd.SelectedItems.Count = 0 Then Exit Sub
Set myBook = ThisWorkbook
Set outSh = ActiveSheet
myPath = fd.SelectedItems(1)

Filename = outSh.[G2].Value & " " & Format(Now, "yyyyMMdd_HHnnss") & ".xlsx"
' 設定檔案保存路徑（更改為所需路徑）
filePath = Range("G1").Value & "\" & Filename

outSh.Copy
Set NewWorkbook = ActiveWorkbook
' 保存新工作簿
NewWorkbook.SaveAs Filename:=filePath
End Sub