麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 複製特定excel檔案 [打印本頁]

作者: pointchi 時間: 2021-12-22 10:02 標題: 複製特定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

作者: samwang 時間: 2021-12-22 10:47

回復 1# pointchi

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

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

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

作者: pointchi 時間: 2021-12-22 22:53

本帖最後由 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

作者: samwang 時間: 2021-12-23 08:35

回復 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 時間: 2021-12-24 22:35

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

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)