Update to this thread from yesterday: Excel VBA: Find data, loop through multiple worksheets, copy specific range of cells
(Special thanks to findwindow for getting me this far!)
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
Yesterday, the error 91 occurred on this:
fRow = rng.Row
Today, after I put in the If/Then section in that area, I'm getting error 1004 (Method 'Range' of object "_Worksheet' failed) on:
Set copyRng = ws.Range(Cells(fRow, 1), Cells(fRow, 18))
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
A quick note - and possibly the solution:
I see you're working with multiple worksheets - this is fine, just remember to be hyper vigilant in setting ranges.
For your Set copyRng
, you correctly specify ws.Range
, but you also need to do that for the Cells()
. There are two fixes, use this: Set copyRng = ws.Range(ws.Cells(fRow, 1), ws.Cells(fRow, 18))
Or, use With
(my personal preference):
With ws
Set copyRng = .Range(.Cells(fRow,1),.Cells(fRow,18))
End with
In the With
case, you'll notice you can just use a decimal as a placeholder for whatever your With __
is. (I like With
, because if your worksheet variable is long, or you're just using the actual name, having to repeat that in thisIsMyWorksheet.Range(thisismyWorksheet.Cells(1,1),thisismyworksheet.cells(...
can get quite long).
If that doesn't do the trick, let me know. I've had spreadsheets hang up when I forget to explicitly give the Cells()
worksheet, after giving the Range
one.
Edit: Per your comment, First, it looks like there's a typo in your If ring Is Nothing
- should be If rng Is Nothing Then
. I don't like that "If (TRUE) Then [implicitly do nothing]".
Try this instead, for the worksheet loop:
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.