Sub 複製指定工作表()
Dim Fn$, Sn$, S, uBook As Workbook, uSht As Worksheet, xBook As Workbook, xS As Worksheet
'↑宣告變數:(Fn,Sn)是字串變數,S是通用型變數,
'(uBook,xBook)是活頁簿變數,(uSht,xS)是工作表變數
Set uBook = ThisWorkbook
'↑令uBook這活頁簿變數是 本活頁簿
Fn = Sheet1.[P2] & ".xls"
'↑令Fn這字串變數是 第一個工作表的[P2]儲存格值,連接".xls"的新字串
On Error Resume Next: Set xBook = Workbooks(Fn): On Error GoTo 0
'↑令程序遇錯暫跳過錯誤執行下個程序:令xBook這活頁簿變數是 名為Fn變數的活頁簿,
'接著就恢復偵錯
If xBook Is Nothing Then Set xBook = Workbooks.Open(uBook.Path & "\" & Fn)
'↑如果xBook變數是不存在(還沒被開啟)!就開啟在本活頁簿資料夾裡的Fn變數的活頁簿
uBook.Activate
'↑啟用uBook變數
Sn = "Base Station Transport Data/Data_LTE/Data_NR/LTE Cell/NR Cell/NRDUCELL/NRDUCellCoverage"
'↑令Sn這字串變數是 以"/"連接7個工作表名稱的字串
Application.ScreenUpdating = False
'↑令螢幕暫不隨著程序的執行作結果變化
For Each S In Split(Sn, "/")
'↑設順迴圈!令S這通用型變數是 一維陣列裡的一員,
'一維陣列:以"/"符號分割Sn變數的字串陣列
On Error Resume Next
'↑令程序遇錯暫跳過錯誤執行下個程序
Set xS = xBook.Sheets(S & "")
'↑令xS這工作表變數是 xBook變數活頁簿(另開啟檔)的 名為S變數工作表
Set uSht = uBook.Sheets(S & "")
'↑令uSht這工作表變數是 uBook變數活頁簿(本檔)的 名為S變數工作表
On Error GoTo 0
'↑令恢復偵錯
If xS Is Nothing Then MsgBox "公司原檔找不到〔" & S & "〕工作表!!!": GoTo s01
'↑如果xS是不存在!就跳出提視窗~~!按確定鈕後跳到 s01標示的程序位置繼續執行
If uSht Is Nothing Then MsgBox "本檔案找不到〔" & S & "〕工作表,請確認後再重新執行!!!": Exit Sub
'↑如果uSht是不存在!就跳出提視窗~~!按確定鈕後 結束程式執行
uSht.UsedRange.Clear
'↑令uSht變數的有使用儲存格做 清除
Range(xS.[a1], xS.UsedRange).Copy uSht.[a1]
'↑令xS變數的[A1]聯集有使用儲存格擴展至最小方正範圍儲存格,複製到uSht變數的[A1]儲存格
Set xS = Nothing: Set uSht = Nothing
'↑令釋放變數
s01: Next S
xBook.Close 0
'↑令xBook變數關閉(0是不存檔)
uBook.Sheets(1).Select
'↑令螢幕畫面落在本檔第一個工作表
End Sub作者: shuo1125 時間: 2023-3-9 22:08
Dim Fn_ALL, Sn_ALL, x%
'↑宣告同模組變數:(Fn_ALL,Sn_ALL)是通用型變數,x是短整數變數
Sub Copysheets()
Fn_ALL = Array([A2], [A3]): Sn_ALL = Array("A/B/C", "D/E/F")
'↑令Fn_ALL這同模組變數是一維陣列,以[A2],[A3]兩個儲存格帶入
'↑令Sn_ALL這同模組變數是一維陣列,以"A/B/C", "D/E/F"兩個字串帶入
If UBound(Fn_ALL) <> UBound(Sn_ALL) Then Exit Sub
'↑如果Fn_ALL陣列最後索引號 <> Sn_ALL陣列最後索引號!就結束程式執行
'↑活頁簿與工作表不對稱不執行
For x = 0 To UBound(Fn_ALL)
'↑設順迴圈!x從0到 Fn_ALL陣列最後索引號
Call 複製指定工作表
'↑令執行(複製指定工作表)副程式
Next
MsgBox "已複製完畢"
End Sub
Sub 複製指定工作表()
Dim Fn$, Sn$, S, tBook As Workbook, tSht As Worksheet, sBook As Workbook, Sw As Worksheet
Application.ScreenUpdating = False
Set tBook = ThisWorkbook
Fn = Fn_ALL(x).Value & ".xlsx"
'↑令Fn這字串變數是 第x變數索引號的Fn_ALL變數(陣列)值 連接".xlsx"字串後的新字串
'Array([A2], [A3])是以儲存格帶入陣列,不是字串,所以要加 .Value
On Error Resume Next: Set sBook = Workbooks(Fn): On Error GoTo 0
If sBook Is Nothing Then Set sBook = Workbooks.Open(tBook.Path & "\" & Fn)
tBook.Activate
Sn = Sn_ALL(x)
'↑令Sn這字串變數是 第x變數索引號的Sn_ALL變數(陣列)值
For Each S In Split(Sn, "/")
On Error Resume Next
Set Sw = sBook.Sheets(S & "")
Set tSht = tBook.Sheets(S & "")
On Error GoTo 0
If Sw Is Nothing Then MsgBox "原檔找不到〔" & S & "〕工作表!!!": GoTo s01
If tSht Is Nothing Then MsgBox "本檔案找不到〔" & S & "〕工作表,請確認後再重新執行!!!": Exit Sub
tSht.UsedRange.Clear
Range(Sw.[A1], Sw.UsedRange).Copy tSht.[A1]
Set Sw = Nothing: Set tSht = Nothing
s01: Next S
sBook.Close 0
tBook.Sheets(1).Select
Application.ScreenUpdating = True
End Sub作者: shuo1125 時間: 2023-3-10 10:55