Excel VBA更新:查找数据,通过多个工作表循环,复制范围

从昨天更新到此线程: Excel VBA:查找数据,循环通过多个工作表,复制特定范围的单元格

(特别感谢findwindow让我这么远!)

我一直在某个部分得到一个运行时错误91,并最终把一个If / Then语句跳到下一个表…但现在我得到一个错误1004就在它下面的线(见下文):

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 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") Set rng = .Find(What:=A, After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If ring Is Nothing Then 'do nothing Else fRow = rng.Row Set copyRng = ws.Range(Cells(fRow, 1), Cells(fRow, 18)) Destination = copyRng End With Next ws Application.ScreenUpdating = True End Sub 

昨天发生了这个错误91:

fRow = rng.Row

今天,在我放入该区域的If / Then部分后,出现错误1004(对象“_Worksheet”失败的方法“范围”):

设置copyRng = ws.Range(Cells(fRow,1),Cells(fRow,18))

语法正在工作,它似乎正在寻找正确的工作簿,但我不知道是否因为我正在search的variables(variablesA)卡住了,因为第一张纸上不存在。 有任何想法吗?

不知道这是你在找什么? 如果失踪了,结束了吗? 您可以在一行中进行复制。 见下文 …

 For Each ws In X.Worksheets With ws.Range("A:A") Set rng = .Find(What:=A, After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If rng Is Nothing Then 'do nothing Else fRow = rng.Row ws.Range("A" + CStr(fRow) + ":" + "R" + CStr(fRow)).Copy Destination:=Destination End If End With Next ws 

一个简短的说明 – 也可能是解决scheme:

我看到你正在处理多个工作表 – 这很好,只要记得在设置范围时要高度警惕。

对于您的Set copyRng ,您正确地指定ws.Range ,但您也需要为Cells() 。 有两个修复,使用这个: Set copyRng = ws.Range(ws.Cells(fRow, 1), ws.Cells(fRow, 18))

或者,使用With (我的个人偏好):

 With ws Set copyRng = .Range(.Cells(fRow,1),.Cells(fRow,18)) End with 

With情况下,你会注意到你可以用一个小数作为占位符来代替With __ 。 (我喜欢With ,因为如果你的工作表variables很长,或者你只是使用实际的名字,不得不在thisIsMyWorksheet.Range(thisismyWorksheet.Cells(1,1),thisismyworksheet.cells(...相当长)。

如果这不能解决问题,请告诉我。 当我忘记明确给出Cells()工作表后,我给电子表格挂了电。

编辑:根据你的评论,首先,它看起来像你的错字是If ring Is Nothing – 应该是If rng Is Nothing Then 。 我不喜欢那个“如果(TRUE)那么[隐含地不做任何事情]”。

试试这个工作表循环:

 For Each ws In X.Worksheets With ws.Range("A:A") Set rng = .Find(What:=A, After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not rng Is Nothing Then fRow = rng.Row Set copyRng = ws.Range(ws.Cells(fRow, 1), ws.Cells(fRow, 18)) Destination.Value = copyRng.Value End With Next ws Application.ScreenUpdating = True End Sub