Question

从昨天开始更新此帖子：Excel VBA: Find data, loop through multiple worksheets, copy specific range of cells

（特别感谢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））

语法正常工作，它似乎正在查找正确的工作簿，但我不确定它是否会卡住，因为我正在搜索的变量（变量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(...中重复这个变量可能会很长。）

如果不能解决问题，请告诉我。当我忘记在给出Cells()之后明确提供Range工作表时，我已经将电子表格挂断了。

编辑：根据你的评论，首先，您的If ring Is Nothing似乎有一个拼写错误 - 应该是If rng Is Nothing Then。我不喜欢＆＃34;如果（TRUE）那么[隐含地什么都不做]＆＃34;。

请尝试使用此工作表循环：

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

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

2 个答案: