返回列表 上一主題 發帖

[發問] 複製特定excel檔案

[發問] 複製特定excel檔案

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

公司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

Downloads.rar (38.63 KB)

回復 1# pointchi

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

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

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

TOP

本帖最後由 pointchi 於 2021-12-22 22:54 編輯

回復 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

TOP

回復  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

TOP

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

TOP

        靜思自在 : 多做多得。少做多失。
返回列表 上一主題