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 t
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
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