[發問] 資料複製貼上問題。

stephenlee

我有 2個工作表,一個是資料來源, 另一個是要從 資料來源中,
將資料複製過去的工作表。

例如在100欄中複製約10欄, 而每一次 我都是自己每一行 從 第二列複製至尾,再每一行貼上至 目標工作表,這樣下來會很花時間。

同時因為 資料來源的欄位排列未必是每次一樣, 今天在 A欄的資料,明天可能在C欄, 但是 欄位的名稱是固定不變的。

我想用VBA 先尋找 資料來源的固定欄位名稱, 再由該欄位的第二列 打直複製至目標工作表的固定欄位的第二至尾列。

例如工作表1,有很多資料, 但我只需 4個欄位名稱的資料, 將資料複製至工作表2 內。

意思是找尋 資料來源的欄位, 再配目標貼上工作表上的欄位。

因為還有其他工作表是超於100欄的, 同時要抽取的資料,也很多, 如何用VBA 做以上動作,謝謝。


資料來源的活頁簿名稱 不是固定的, 而活頁簿的工作表名為 Raw Data 是固定的

貼到 另外一個活頁簿名為Data.xlsm內的 名稱工作表1 內

question 2.zip (9.23 KB)

下載次數: 2

2020-7-18 12:42

准提部林

資料來源檔檔名不固定, 須手動開啟再執行程式:
Sub 複製()
Dim xB As Workbook, xU As Range, R&
Dim Sht As Worksheet, A, C%, xF As Range
Set Sht = Sheets("工作表1")
Sht.UsedRange.Offset(1, 0).EntireRow.Delete
'-------------------------------------
For Each xB In Workbooks
    On Error Resume Next
    If xB.Name = ThisWorkbook.Name Then GoTo 101
    Set xU = xB.Sheets("Raw Data").UsedRange
    R = xU.Rows.Count - 1
    If Not xU Is Nothing Then Exit For
101: Next
On Error GoTo 0
If xU Is Nothing Then MsgBox "來源檔案未開啟!  ": Exit Sub
If R = 0 Then MsgBox "來源檔案無資料!  ": Exit Sub
'欄位::數量-號碼-名稱-日期
For Each A In Array("Total Qty", "no", "name", "date2")
    C = C + 1
    Set xF = xU.Rows(1).Find(A, Lookat:=xlWhole)
    If Not xF Is Nothing Then xF(2).Resize(R).Copy Sht.Cells(2, C)
Next
End Sub

XX001.rar (20.42 KB)

下載次數: 7

2020-7-19 11:29

================================

stephenlee

資料來源檔檔名不固定, 須手動開啟再執行程式:
Sub 複製()
Dim xB As Workbook, xU As Range, R&
Dim Sh ...
准提部林 發表於 2020-7-19 11:29

  准大,謝謝幫忙。

我想請問一下如果是在其他Workbooks內的Worksheet("Raw Data")內 複製資料至
另外一個Workbook內的Worksheet("工作表1")內。


  If xB.Name = ThisWorkbook.Name Then GoTo 101


  If xB.Name <> ThisWorkbook.Name Then GoTo 101


我將=, 轉換成 <> 但都是不能成功。

我要分開Raw Data 頁是在另一個Workbook內複製資料去 另外一個WOrkbook內的"工作表1"內。

"Raw Data" Worksheet是固定名稱,而Workbooks名稱則是不固定。
而"工作表1"是固定名稱,同時Workbooks名稱也是固定叫"Data.slxm"謝謝

cody

  If xB.Name <> ThisWorkbook.Name Then GoTo 101
我將=, 轉換成 <> 但都是不能成功。
...
stephenlee 發表於 2020-9-15 10:54

  If Not xB.Name = ThisWorkbook.Name Then GoTo 101