从昨天开始对此线程进行更新: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”的方法“ Range”失败):


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


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

最佳答案

不知道这是您要找的东西吗?
如果失踪了,那末了吗?您可以在一行中进行复制。见下文 ...

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

10-05 21:25