帖子: 17
主題: 6
精華: 0
積分: 73
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 20
註冊時間: 2018-11-2
最後登錄: 2024-10-18

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2023-3-4 02:33 | 只看該作者

搜尋指定工作表再全頁複製到另一檔案中

在公司的檔案中, 有些工作表是不太有用, 自己想將有用的工作表, 從原檔案中全頁複製到另一excel檔中, ...

公司原檔"Basic_xxx", 將以下名稱全頁複製到 "10xxx_New_v2" 檔中同名稱位置....
Base Station Transport Data/Data_LTE/Data_NR/LTE Cell/NR Cell/NRDUCELL/NRDUCellCoverage

想在"10xxx_New_v2"第一頁中, 加了一個按鈕, 一按下就可將原檔內的工作表複製....

希望高手們幫忙改一下, 先謝謝.

Temp.zip (500.48 KB)

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

2^#

發表於 2023-3-4 11:50 | 只看該作者

副檔名 xls 須自行更改為 xlsx

新資料夾001.rar (283.25 KB)

TOP

rcyw

中學生 Rank: 2

帖子: 17
主題: 6
精華: 0
積分: 73
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 20
註冊時間: 2018-11-2
最後登錄: 2024-10-18

3^#

發表於 2023-3-4 19:39 | 只看該作者

回復 2# 准提部林

再次感謝准提部林大大的回覆, 真的省下自己逐頁copy的時間, 非常好用.....:)

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

4^#

發表於 2023-3-6 11:55 | 只看該作者

本帖最後由 Andy2483 於 2023-3-6 11:59 編輯

回復 1# rcyw
回復 2# 准提部林

謝謝 rcyw前輩發表此主題與範例
謝謝准提部林前輩指導
後學學習心得如下請前輩指導

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

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

TOP

shuo1125

中學生 Rank: 2

帖子: 121
主題: 8
精華: 0
積分: 170
點名: 62
作業系統: win10
軟體版本: Office2016
閱讀權限: 20
性別: 男
註冊時間: 2021-1-21
最後登錄: 2024-8-20

5^#

發表於 2023-3-9 22:08 | 只看該作者

本帖最後由 shuo1125 於 2023-3-9 22:10 編輯

回復 2# 准提部林
rcyw 版大不好意思借搭版!
准大好!
想請問若有多工作簿多工作表複製是否可單一程序碼執行完成....?
詳如附件，可否勞煩准大抽空解答?感激不盡~!

TEXT.zip (35.08 KB)

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

6^#

發表於 2023-3-10 08:07 | 只看該作者

本帖最後由 Andy2483 於 2023-3-10 08:16 編輯

回復 5# shuo1125

謝謝前輩發表此帖
後學練習以迴圈執行副程式的方案,請前輩參考
請各位前輩指導

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

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

TOP

shuo1125