Excel VBA：查找数据，遍历多个工作表，复制特定范围的单元格

Question

我正在为将分发给一组人员的文件创建一个宏；该函数应该能够从另一个单元格（在变量 B 中）中提取该人的姓名，在另一个具有多个工作表（变量 X）的工作簿中搜索该值，如果找到，则将工作簿 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)，因为较新的数据只会覆盖现有数据（除非这是您想要的）。您可以考虑添加错误检查。

最后，一个切线，但你真的很棒，接受了 cmets 和建议，然后进行研究以解决所有问题并提出新问题 ^_^

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