Excel VBA更新：查找数据，遍历多个工作表，复制范围

Question

从昨天更新到此线程： 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”的方法“ Range”失败）：

设置copyRng = ws.Range（Cells（fRow，1），Cells（fRow，18））

语法在起作用，似乎在正确的工作簿中查找，但是我不确定它是否卡住了，因为我要搜索的变量（变量A）没有出现在第一张纸上。 有任何想法吗？

Answer 1

不确定这是您要找的东西吗？ 如果失踪了，那末了吗？ 您可以在一行中进行复制。 见下文 ...

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

Answer 2

快速说明-以及可能的解决方案：

我看到您正在使用多个工作表-很好，请记住要对设置范围保持高度警惕。

对于您的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 ，因为如果您的工作表变量很长，或者您只是使用实际名称，则必须在thisIsMyWorksheet.Range(thisismyWorksheet.Cells(1,1),thisismyworksheet.cells(...相当长）。

如果那不能解决问题，请告诉我。 在给Range一个后，忘记显式提供Cells()工作表时，我挂了电子表格。

编辑：根据您的评论，首先，您的If ring Is Nothing好像If ring Is Nothing都If rng Is Nothing Then - If rng Is Nothing Then应该If rng Is Nothing Then 。 我不喜欢“ If（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