Excel VBA：查找數據，遍歷多個工作表，復制特定范圍的單元格

Question

我正在為將要分發給團隊的文件創建宏； 該功能應該能夠從另一個單元格（在變量B中）提取人的名字，在具有多張圖紙的另一個工作簿中搜索該值（變量X），如果找到，則將特定范圍的單元格從Workbook X復制到練習冊B。

我在使用以下代碼時遇到麻煩：

Sub Pull_data_Click()

Dim A As Variant 'defines name from first subroutine
Dim B As Workbook 'defines destination file
Dim X As Workbook 'defines existing report file as source
Dim Destination As Range 'defines destination range of data pulled from report
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range

A = Workbooks("filenameB.xlsm").Worksheets("Summary").Range("A1").Value 'constant variable, does not change
Set B = Workbooks("filenameB.xlsm") 'constant variable, does not change
Set X = Workbooks.Open("filenameX.xlsm") 'dependent variable, new name for each new report
Set Destination = Workbooks("filenameB.xlsm").Worksheets("Input").Range("B2:S2") 'Range changes for each iteration, rows increase by 1

'check if name is entered
If A = "" Then
MsgBox ("Your name is not visible; please start from the Reference tab.")
B.Worksheets("Reference").Activate
Exit Sub
End If

With X.Worksheets
For Each ws In X.Worksheets
Set rng = Cells.Find(What:=A, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            ActiveCell.Activate
            ActiveSheet.Range("$A$2:$DQ$11").AutoFilter Field:=1, Criteria1:=A
            Range("A7:CD7").Select
            Selection.Copy
            B.Activate
            Destination.Activate
            Destination.PasteSpecial Paste:=xlPasteValues

Next ws
End With


Application.ScreenUpdating = False

End Sub

它能夠成功編譯並且沒有運行時錯誤，並且它在運行時似乎正確地循環了工作表...但是它粘貼了錯誤的信息。 有沒有我沒有正確設置的內容？

Answer 1

這未經測試。 我對我想做的事不屑一顧。 您正在將A2過濾到DQ11，所以這就是我設置find范圍的地方。 然后將B2粘貼到S2，只有11列寬，這就是我要獲取的數據范圍。 由於您要粘貼值（無需格式化），因此我將目標范圍直接設置為源范圍，而不是復制/粘貼。

再次，未經測試，但我可以嘗試解決錯誤。 我預計范圍錯誤XD簡而言之，請先備份，然后再嘗試我的代碼。

另外，不確定是否希望在每張紙上查找數據。 如果是這樣，則不能將目標范圍設置為常數（B2：S2），因為較新的數據只會覆蓋現有數據（除非您要這樣做）。 您可以考慮添加錯誤檢查。

最后，切線，但是您確實很棒，可以提出意見和建議，然后進行研究以找出所有問題並返回新問題^ _ ^

Sub Pull_data_Click()    
Dim A As Variant 'defines name from first subroutine
Dim B As Workbook 'defines destination file
Dim X As Workbook 'defines existing report file as source
Dim Destination As Range 'defines destination range of data pulled from report
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Variant
Dim copyRng As Variant
Dim fRow As Long

Application.ScreenUpdating = False

Set B = Workbooks("filenameB.xlsm") 'constant variable, does not change
Set X = Workbooks.Open("filenameX.xlsm") 'dependent variable, new name for each new report
'once you set a wordbook, you can use it ^_^
A = B.Worksheets("Summary").Range("A1").Value 'constant variable, does not change
Set Destination = B.Worksheets("Input").Range("B2:S2") 'Range changes for each iteration, rows increase by 1

'check if name is entered
If A = "" Then
MsgBox ("Your name is not visible; please start from the Reference tab.")
B.Worksheets("Reference").Activate
Exit Sub
End If


For Each ws In X.Worksheets
with ws.range("A:A")
On Error Resume Next '<---add
Set rng = .Find(What:=A, After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

            fRow = rng.Row
            Set copyRng = ws.Range(Cells(fRow, 1), Cells(fRow, 18)) 'i think you want 18 because you're pasting to a range that is 18 cols wide
            Destination = copyRng
end with '<-- move it here            
Next ws

Application.ScreenUpdating = True
end sub