Excel VBA更新：查找数据，循环遍历多个工作表，复制范围 [英] Excel VBA Update: Find data, loop through multiple worksheets, copy range

问题描述

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

Update to this thread from yesterday: Excel VBA: Find data, loop through multiple worksheets, copy specific range of cells

（特别感谢findwindow获取我这个远了！）

(Special thanks to findwindow for getting me this far!)

我在某个部分继续遇到运行时错误，最后放入一个If / Then语句跳到下一张表...但是现在我正在下面的错误1004（见下文）：

I kept getting a runtime 91 error on a certain section, and eventually put in an If/Then statement to skip to the next sheet...but now I'm getting an error 1004 on the line right below it (see below):

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

fRow = rng.Row

今天，放在该区域的If / Then部分，我收到错误1004（对象_Worksheet失败的方法'范围）：

Today, after I put in the If/Then section in that area, I'm getting error 1004 (Method 'Range' of object "_Worksheet' failed) on:

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

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

语法正在运行，看正确的工作簿，但我不知道是否因为我正在搜索的变量（变量A）不存在在第一张表上。任何想法？

The syntax is working and it seems to be looking in the correct workbook, but I'm not sure if it's getting stuck because the variable I'm searching for (Variable A) isn't present on the first sheet. Any ideas?

推荐答案

不知道这是你要找的？
如果丢失了结尾？您可以在一行中进行复制。见下文...

Not sure if this is what you are looking for? There was an end if missing? You can do the copy in a single line. See below ...

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

这篇关于Excel VBA更新：查找数据，循环遍历多个工作表，复制范围的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！