返回列表 上一主題 發帖

[發問] 工作表複製跨另一檔案工作表

本帖最後由 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
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 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
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 n7822123 於 2021-7-25 14:01 編輯

回復 4# BV7BW


複製到另一檔案工作表則無法進行.不知哪裡錯誤

二樓程式是預設你的輸出檔案 "訂貨明細存檔.xlsm" 是未開啟狀態

如果你原本就開啟,程式重複開啟自動取消複製狀態,也就沒辦法貼上了

8樓程式增加彈性,原本有開啟、沒開啟都適用 (彈性越大,通常程式碼越長,所以請盡量敘述清楚)

並修改全資料複製(標題除外),但是程式結束,是預設統一把輸出檔關閉~

另外我看你很多巨集按鈕都設在 "訂貨明細表",所以我的程式也是預設在那裡

程式執行前,請切回"訂貨明細表",在不同活頁簿狀態,8樓程式還是會出錯(找不到Copy來源)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 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
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 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
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

        靜思自在 : 一句溫暖的話,就像往別人身上灑香水,自己會沾到兩三滴。
返回列表 上一主題