圖1是正在使用的表格，圖2是格式相同資料不同的excel檔案之一，需要打開圖2的表格，把K列圖示幾個資料復制到，圖1中B列編號與圖2中A6相同編號的C D E F G H列對應行的位置
uj5u.com熱心網友回復：
圖2表格可能有幾十、上百、上千個excel表，名稱不同，A6及其它資料不同，格式完全一樣，圖2的表格需要的資料都在SHEET(AC)uj5u.com熱心網友回復：
運行后彈出檔案選擇對話框，選擇要匯總的檔案(可以多選)后確定Sub demo()
Dim i As Long, arr, tempArr, d As Object
Set d = CreateObject("scripting.dictionary")
arr = Range(Cells(5, 2), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 7)).Value
For i = 1 To UBound(arr)
d(arr(i, 1) & "") = i
Next i
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Excel 檔案(*.xl*)", "*.xl*"
.Title = "選擇匯總表"
.Show
On Error Resume Next
For i = 1 To .SelectedItems.Count
With Workbooks.Open(.SelectedItems(i))
With .Sheets("AC")
tempArr = .Range("A6:E11").Value
arr(d(tempArr(1, 1) & ""), 2) = tempArr(1, 5)
arr(d(tempArr(1, 1) & ""), 3) = tempArr(2, 5)
arr(d(tempArr(1, 1) & ""), 4) = tempArr(3, 5)
arr(d(tempArr(1, 1) & ""), 5) = tempArr(4, 5)
arr(d(tempArr(1, 1) & ""), 6) = tempArr(5, 5)
arr(d(tempArr(1, 1) & ""), 7) = tempArr(6, 5)
End With
.Close False
End With
Next i
Err.Number = 0
On Error GoTo 0
Range(Cells(5, 2), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 7)).Value = arr
End With
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/191164.html
標籤：VBA