標題:
[發問]
工作表複製跨另一檔案工作表
[打印本頁]
作者:
BV7BW
時間:
2021-7-24 08:58
標題:
工作表複製跨另一檔案工作表
各位 前輩先進 大家好
如何將工作表中資料複製到另一工作表.
並複製跨檔案中另一工作表存檔.
"複製貼上資料時以下1行貼上"
謝謝指教[attach]33736[/attach][attach]33737[/attach]
作者:
n7822123
時間:
2021-7-24 15:27
本帖最後由 n7822123 於 2021-7-24 15:28 編輯
回復
1#
BV7BW
你講的有些籠統~
大概寫一個給你,在"
訂貨明細表
"隨意選擇有資料的一格,執行以下程式
即可複製該列,到同檔另1工作表,以及不同檔的工作表
程式預設兩個檔案都在同一個資料夾下(可自行調整程式內的
輸出路徑
、
輸出檔名
)
Sub Test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Ri& = Selection.Row
Cn& = [A1].End(2).Column
Cells(Ri, 1).Resize(, Cn).Copy
[明細存檔!A1].End(4)(2).PasteSpecial '複製到另工作表(同檔案)
'===以下為複製到另一檔案工作表===
oPath$ = ThisWorkbook.Path '自定輸出路徑
oFile$ = "訂貨明細存檔.xlsm" '自定輸出檔名
On Error Resume Next
Set oWb = GetObject(oPath & "\" & oFile) '背景開啟
If Err <> 0 Then MsgBox "找不到輸出檔 '" & oPath & "\" & oFile & "',請確認!": GoTo Over
On Error GoTo 0
oWb.Sheets(1).[A1].End(4)(2).PasteSpecial '複製到另工作表(不同檔案)
Windows(oFile).Visible = True '關閉前取消背景隱藏
oWb.Close 1: Set oWb = Nothing
Over: Application.CutCopyMode = False
End Sub
作者:
Andy2483
時間:
2021-7-24 16:06
回復
1#
BV7BW
另類管理表供參考!
1.如果資料量不大! 建議不需要拆成兩份表! 用篩選方式即可區別出貨.未出貨或取消訂單…等 歷史資料查詢也方便
2.很多空欄位是備用欄! 可方便增加資料欄且不必修改程式碼!
3.善用篩選功能!
以上供參考!
作者:
BV7BW
時間:
2021-7-24 17:45
回復
2#
n7822123
感謝 n7822123 阿龍大大
經測試後.複製至另一工作表"明細存檔"只有1行.是否可整工作表"訂貨明細表"中所有資料1次全複製至"明細存檔"中
並"複製貼上資料時以下1行接上貼上"
複製到另一檔案工作表則無法進行.不知哪裡錯誤
需求是:將"訂貨明細表"中所有資料複製至另一檔案"訂貨明細存檔"中工作表"訂貨明細表存檔"
並"複製貼上資料時以下1行接上貼上"
謝謝 n7822123 阿龍大大 指導
作者:
BV7BW
時間:
2021-7-24 17:51
回復
3#
Andy2483
感謝 anby2483 大大 你好
感謝 大大所提供解答
抱歉.因單純複製貼上.
故無法測試 anby2483 大大 指導項目進行測試
感謝 anby2483 大大
謝謝你
作者:
Andy2483
時間:
2021-7-24 18:09
回復
5#
BV7BW
路過 純經驗分享!
作者:
BV7BW
時間:
2021-7-24 18:13
回復
6#
Andy2483
感謝 anby2483 大大
謝謝你
作者:
n7822123
時間:
2021-7-25 12:57
本帖最後由 n7822123 於 2021-7-25 13:08 編輯
回復
4#
BV7BW
開啟訂貨明細表,執行以下程式
訂貨明細存檔 有開啟、沒開啟,隨意
試試看
Sub Test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
[訂貨明細表!A1].CurrentRegion.Offset(1).Copy
[明細存檔!A1].End(4)(2).PasteSpecial
'===以下為複製到另一檔案工作表===
oPath$ = ThisWorkbook.Path '自定輸出路徑
oFile$ = "訂貨明細存檔.xlsm" '自定輸出檔名
oSNm$ = "訂貨明細表存檔" '自定輸出表名
On Error Resume Next
Set oWb = Workbooks(oFile$)
If Err <> 0 Then Err.Clear: Set oWb = Workbooks.Open(oPath & "\" & oFile)
If Err <> 0 Then MsgBox "找不到輸出檔 '" & oPath & "\" & oFile & "',請確認!": GoTo Over
On Error GoTo 0
oWb.Sheets(oSNm).[A1].End(4)(2).PasteSpecial '複製到另工作表(不同檔案)
oWb.Close 1: Set oWb = Nothing
Over: Application.CutCopyMode = False
End Sub
作者:
n7822123
時間:
2021-7-25 13:47
本帖最後由 n7822123 於 2021-7-25 14:01 編輯
回復
4#
BV7BW
複製到另一檔案工作表則無法進行.不知哪裡錯誤
二樓程式是預設你的輸出檔案 "
訂貨明細存檔.xlsm
" 是未開啟狀態
如果你原本就開啟,程式
重複開啟
會
自動取消
複製狀態,也就沒辦法貼上了
8樓程式增加彈性,原本有開啟、沒開啟都適用 (彈性越大,通常程式碼越長,所以請盡量敘述清楚)
並修改全資料複製(標題除外),但是程式結束,是預設統一把輸出檔
關閉
~
另外我看你很多巨集按鈕都設在 "
訂貨明細表
",所以我的程式也是預設在那裡
程式執行前,請切回"
訂貨明細表
",在不同活頁簿狀態,8樓程式還是會出錯(找不到Copy來源)
作者:
BV7BW
時間:
2021-7-25 21:56
回復
9#
n7822123
感謝 n7822123 阿龍大大 你好
謝謝你指導.再理解過後.再向你祥述
再次謝謝你 n7822123 阿龍大大
作者:
BV7BW
時間:
2021-7-26 07:54
回復
9#
n7822123
n7822123 阿龍老師 你好
經測試後.以可運用
發現1問題
當複至同一工作表清空"明細存檔"只留"A1"標題欄時
出現"[明細存檔!A1].End(4)(2).PasteSpecial"出現錯誤
同樣複製另檔案工作表出現"oWb.Sheets(oSNm).[A1].End(4)(2).PasteSpecial '複製到另工作表(不同檔案)出現錯誤
需清空時留1筆資料才會複製貼上
"A1"為標題欄
也就是每月需存檔時.先把工作表中資料清空.不能全清空.需留"A1""A2"欄中資料.才能運用
感謝 n7822123 阿龍老師 指導
作者:
n7822123
時間:
2021-7-26 09:43
回復
11#
BV7BW
改一下,試看看~
Sub Test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
[訂貨明細表!A1].CurrentRegion.Offset(1).Copy
Sheets("明細存檔").Cells(Rows.Count,1)
.End(
3
)(2).PasteSpecial
'===以下為複製到另一檔案工作表===
oPath$ = ThisWorkbook.Path '自定輸出路徑
oFile$ = "訂貨明細存檔.xlsm" '自定輸出檔名
oSNm$ = "訂貨明細表存檔" '自定輸出表名
On Error Resume Next
Set oWb = Workbooks(oFile$)
If Err <> 0 Then Err.Clear: Set oWb = Workbooks.Open(oPath & "\" & oFile)
If Err <> 0 Then MsgBox "找不到輸出檔 '" & oPath & "\" & oFile & "',請確認!": GoTo Over
On Error GoTo 0
oWb.Sheets(oSNm).
Cells(Rows.Count,1)
.End(
3
)(2).PasteSpecial '複製到另工作表(不同檔案)
oWb.Close 1: Set oWb = Nothing
Over: Application.CutCopyMode = False
End Sub
作者:
BV7BW
時間:
2021-7-26 10:33
回復
12#
n7822123
感謝 n7822123 阿龍老師 你好
測試後.以完全運用成功
非常謝謝你
再次感謝你
作者:
BV7BW
時間:
2021-7-26 11:45
回復
12#
n7822123
n7822123 阿龍老師 你好
測試後.以完全運用
是否可追加清除
要複製工作表"明細存檔"前.先清除"A2"至"N65536"後再貼上資料
複製另一檔案"訂貨明細存檔"中工作表"訂貨明細表存檔"前.先清除"A2"至"N65536"後再貼上資料
謝謝
作者:
BV7BW
時間:
2021-7-30 10:08
回復
12#
n7822123
n7822123 阿龍老師 你好
經修改增列"明細存檔"清除後再行貼上資料部份已可運行[attach]33799[/attach][attach]33799[/attach]
複製另一檔案"訂貨明細存檔"中工作表"訂貨明細表存檔"增列清除後再行貼上資料部份
卻不解從何處增列清除後再行貼上資料之程式[attach]33800[/attach]
也就是說:當需複製前先將"明細存檔"清除後才貼上資料
:當需複製前先將"訂貨明細存檔"清除後才貼上資料
是否可請 n7822123 阿龍老師 賜教
謝謝
作者:
n7822123
時間:
2021-7-30 23:00
本帖最後由 n7822123 於 2021-7-30 23:02 編輯
回復
15#
BV7BW
也就是說:當需複製前先將"明細存檔"清除後才貼上資料
:當需複製前先將"訂貨明細存檔"清除後才貼上資料
這樣感覺更簡單了呀......全部清除在全部複製貼上就好(含標題列)
如果不是工作表名、檔名不一樣,我都想要直接複製檔案了
Sub Test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set 此表 = ActiveSheet
Sheets("明細存檔").Cells.Clear '含格式全部清除
此表.[A1].CurrentRegion.Copy [明細存檔!A1] '複製貼上
'===以下為複製到另一檔案工作表===
oPath$ = ThisWorkbook.Path '自定輸出路徑
oFile$ = "訂貨明細存檔.xlsm" '自定輸出檔名
oSNm$ = "訂貨明細表存檔" '自定輸出表名
On Error Resume Next
Set oWb = Workbooks(oFile$)
If Err <> 0 Then Err.Clear: Set oWb = Workbooks.Open(oPath & "\" & oFile)
If Err <> 0 Then MsgBox "找不到輸出檔 '" & oPath & "\" & oFile & "',請確認!": GoTo Over
On Error GoTo 0
oWb.Sheets(oSNm).Cells.Clear '含格式全部清除
此表.[A1].CurrentRegion.Copy oWb.Sheets(oSNm).[A1] '複製到另工作表(不同檔案)
oWb.Close 1: Set oWb = Nothing
Over: Application.CutCopyMode = False
End Sub
作者:
BV7BW
時間:
2021-7-31 07:04
回復
16#
n7822123
感謝 n7822123 阿龍老師 指導
理解後再回報
謝謝你
作者:
BV7BW
時間:
2021-7-31 14:25
回復
16#
n7822123
n7822123 阿龍老師 你好
經測試後完全合乎需求
我修改為2道按鈕工作
第一道為"明細存檔"以第1次程式前段為基點複製到"明細存檔"中
因"明細存檔"不須清除動作.需保留原始資料及修改後資料以便查證
第2道按鈕"訂貨明細存檔"以第2次程式後段為基點複製到"訂貨明細存檔"中.也是主要重點
因複製基本資料為連貫性資料
又因"訂貨明細存檔"需清除前資料後才貼上複製後資料.不至因前資料與至複製後資料重複
列)前資料:123.複製貼上後資料:123456
沒清除會出現123123456.等於123是重複資料.而需求是123456
現以修改完成運用
非常感謝 n7822123 阿龍老師 指導
謝謝
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)