[發問] 複製特定excel檔案

pointchi

糟糕~我又來了，研究卡關。

公司ERP系統會下載一個EXCEL檔案，我的帳號登入後如果下載該資料，
第一次會轉出檔名Link.xls的資料檔
第二次會轉出檔名Link(1).xls的資料檔
第三次會轉出檔名Link(2).xls的資料檔
如果我帳號一直沒有登出，第N次就會轉出檔名Link(N-1).xls的資料檔
之後我會將Link.xls的分頁PickListLinkPDA手工複製貼上至主檔test1.xlsm的分頁raw，然後開始執行VBA處理資料。

之前我是請教，如何用VBA於test1.xlsm執行完動作，也一併將Link(N-1).xls關閉(不用存檔)，也獲得解決。

目前我是想用VBA一開始就去找Link(N-1).xls的分頁raw複製來源，執行我的程序，最後關閉Link(N-1).xls檔案。

目前遇到的新問題是上面紅色字串，請問要如何撰寫這部分的程序讓VBA複製來源Link(N-1).xls的分頁PickListLinkPDA。
下面是我拼湊寫出的VBA，可是開頭就卡住無法執行。

Sub step01()
    Dim wb As Workbook
    For Each wb In Workbooks
            If LCase(wb.Name) Like "Link*.xls*" Then
                Workbooks(wb).Worksheets("PickListLinkPDA").Columns("A:AU").Cells.Copy '複製Link(N-1).xlsx中的PickListLinkPDA表單複製
                Workbooks("test1.xlsm").Worksheets("raw").Select  '貼至主檔test1.xlsm中的raw表單
                Range("A1").Select
                ActiveSheet.Paste
        End If
        
    a = Cells(13, 5)
    If Len(a) >= 28 Then
        Worksheets("raw").Cells(13, 5).Font.Name = "Arial"
        Worksheets("raw").Cells(13, 5).Font.Size = 35
        Worksheets("raw").Cells(13, 5).Font.FontStyle = "粗體"
    Else

        Worksheets("raw").Cells(13, 5).Font.Name = "Arial"
        Worksheets("raw").Cells(13, 5).Font.Size = 48
        Worksheets("raw").Cells(13, 5).Font.FontStyle = "粗體"
    End If  

    For Each wb In Workbooks
            If LCase(wb.Name) Like "Link*.xls*" Then wb.Close 0
    Next
   
End Sub

samwang

回復 1# pointchi

不知我的理解有無錯誤，您的需求如下，請確認，謝謝

逐筆開啟同資料夾有Link xx的檔案--> 複製資料到TEST1檔案Range?? --> 關閉Link xx檔案-->在開啟下一筆Link xx-->....

複製資料範圍??
貼到TEST1的哪裡??

pointchi

回復 2# samwang

逐筆開啟同資料夾有Link xx的檔案(檔案是處於開啟狀態)-->(執行我自己編寫的程序) -->複製資料到TEST1檔案Range?? (如下說明)--> 關閉Link xx檔案(關閉後同時停止程序，只做一輪迴，不再繼續)

S大您好，說明如下：

只有一個Link XX.xls(執行程序的當下是已開啟狀態)，複製裡面的分頁PickListLinkPDA的欄位A至AU的資料，
貼至主檔TEST1.xlsm的分頁raw，A1儲存格貼上。

    Dim wb As Workbook
    For Each wb In Workbooks
        If LCase(wb.Name) Like "Link*.xls*" Then
            Workbooks(wb).Worksheets("PickListLinkPDA").Columns("A:AU").Cells.Copy '複製Link(N-1).xlsx中的PickListLinkPDA表單複製
            Workbooks("test1.xlsm").Worksheets("raw").Select '貼至主檔test1.xlsm中的raw表單
            Range("A1").Select
            ActiveSheet.Paste
        End If
(主要是上面這段程序出現程序錯誤的異常)

然後執行
a = Cells(13, 5)
    If Len(a) >= 28 Then
        Worksheets("raw").Cells(13, 5).Font.Name = "Arial"
        Worksheets("raw").Cells(13, 5).Font.Size = 35
        Worksheets("raw").Cells(13, 5).Font.FontStyle = "粗體"
    Else

        Worksheets("raw").Cells(13, 5).Font.Name = "Arial"
        Worksheets("raw").Cells(13, 5).Font.Size = 48
        Worksheets("raw").Cells(13, 5).Font.FontStyle = "粗體"
    End If

接著關閉Link XX.xls(直接關閉，不用存檔)
    For Each wb In Workbooks
            If LCase(wb.Name) Like "Link*.xls*" Then wb.Close 0
    Next

samwang

回復  samwang

逐筆開啟同資料夾有Link xx的檔案(檔案是處於開啟狀態)-->(執行我自己編寫的程序) -->複 ...
pointchi 發表於 2021-12-22 22:53

  Dim wb As Workbook
     For Each wb In Workbooks
         If LCase(wb.Name) Like "Link*.xls*" Then
             Workbooks(wb).Worksheets("PickListLinkPDA").Columns("A:AU").Cells.Copy '複製Link(N-1).xlsx中的PickListLinkPDA表單複製
            Workbooks("test1.xlsm").Worksheets("raw").Select  '貼至主檔test1.xlsm中的raw表單
            Range("A1").Select
             ActiveSheet.Paste
         End If
(主要是上面這段程序出現程序錯誤的異常)
>> 修改如下，請測試看看，謝謝
For Each wb In Workbooks
    If LCase(wb.Name) Like "link.xls*" Then
        Workbooks(wb.Name).Sheets("PickListLinkPDA").Columns("A:AU").Copy '複製Link(N-1).xlsx中的PickListLinkPDA表單複製
        Windows("TEST1.xlsm").Activate '貼至主檔test1.xlsm中的raw表單
        Range("A1").Select
        ActiveSheet.Paste
    End If
Next

pointchi

回復 4# samwang
感謝S大，已經可以成功執行程序。
感謝~