Excel VBA：查找数据，通过多个工作表循环，复制特定范围的单元格

我正在创build一个将分发给一个人的文件的macros; 该函数应该能够从不同的单元格（在variablesB中）拉取人员的名称，在具有多个工作表（variablesX）的另一个工作簿中search该值，并且如果find，则将工作簿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

这不是testing。 我正在刺激我想要做的事情。 您正在筛选A2到DQ11，这就是我设置find范围的地方。 而你粘贴到B2到S2，只有11列，所以这是我抓住的数据范围。 由于您正在粘贴值（不需要格式），因此我将目标范围直接设置为源范围，而不是复制/粘贴。

再次，未经testing，但我可以尝试帮助错误。 我期待范围错误XD总之，在尝试我的代码之前进行备份。

此外，不知道你是否希望在每张表中find数据。 如果是这样，您不能将目标范围设置为一个常量（B2：S2），因为较新的数据只会覆盖现有的（除非这是你想要的）。 你可能会考虑添加错误检查。

最后，一个切线，但你真的很棒，采取意见和build议，然后做研究，全力以赴，回来了新的问题^ _ ^

 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