How to search on two or more sheets?

[AlexAlexon]

This macro search on sheet1 and range ("A10:A250"). I need to change macro in the way so macro can search on sheet 2 and range ("B5:b25") and Sheet3 and range ("a1:a32").


Private Sub CommandButton1_Click()
Dim rFound As Range
Dim sFirstAdd As String
Dim rLook As Range
Dim rValue As Range
Dim k As Range
Set rValue = Sheet1.Range("A5")
Set rLook = Sheet1.Range("A10:A250")
Set rFound = rLook.Find(rValue.Value, , , xlWhole)
If rFound > 0 Then
rFound.EntireRow.Copy


With Worksheets("Sheet2").Range("1:2")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteComments
'.Cells(RW - 1, 1) = rFound.Value
'.Cells(RW, 2) = rFound.Offset(0, 2).Value
'.Cells(RW, 3) = rFound.Offset(0, 5).Value
'.Cells(RW + 1, 1) = rFound.Offset(1, 0).Value
End With
End If
If rFound > 0 Then
rFound.Offset(1, 0).EntireRow.Copy


With Worksheets("Sheet2").Range("2:2")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteComments

End With
End If

End Sub

[XLGibbs]

Not 100% sure I follow your issue or what the desired result is, but maybe this will give you some ideas.

[VBA]
Private Sub foo()
Dim rFound As Range
Dim rLook As Range
rValue As String
Dim rDest As Range
rValue = Sheet1.Range("A5")
Set rLook = Sheet1.Range("A10:A250")
Set rDest = Worksheets("Sheet2").Range("A1")


Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
rFound.EntireRow.Copy
rDest.PasteSpecial xlValues
rDest.PasteSpecial xlPasteComments
Set rDest = rDest.Offset(1, 0) 'reset the dest range to 1 row below
End If
'reset the range and do again
Set rLook = Worksheets("Sheet2").Range("B5:b25")
Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
rFound.EntireRow.Copy
rDest.PasteSpecial xlValues
rDest.PasteSpecial xlPasteComments
Set rDest = rDest.Offset(1, 0)
End If

Set rLook = Worksheets("Sheet3").Range("a1:a32")
Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
rFound.EntireRow.Copy
rDest.PasteSpecial xlValues
rDest.PasteSpecial xlPasteComments
Set rDest = rDest.Offset(1, 0)
End If


End Sub


[/VBA]

[Bob Phillips]

[vba]

Private Sub CommandButton1_Click()
Call UpdateData(rLook:=Sheet1.Range("A10:A250"), rValue:=Sheet1.Range("A5").Value)
Call UpdateData(rLook:=Sheet2.Range("B2:B25"), rValue:=Sheet1.Range("A5").Value)
Call UpdateData(rLook:=Sheet3.Range("A1:A32"), rValue:=Sheet1.Range("A5").Value)
End Sub

Private Sub UpdateData(rLook As Range, rValue As Range)
Dim rFound As Range
Dim sFirstAdd As String
Dim rLook As Range
Dim k As Range

Set rFound = rLook.Find(rValue.Value, , , xlWhole)
If rFound > 0 Then
rFound.EntireRow.Copy

With Worksheets("Sheet2").Range("1:2")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteComments

End With
End If
If rFound > 0 Then
rFound.Offset(1, 0).EntireRow.Copy

With Worksheets("Sheet2").Range("2:2")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteComments

End With
End If

End Sub
[/vba]

[AlexAlexon]

It works!Thanks very much!
But I need one more thing. This makro copy entire row but I don't need to copy value from column A.

[XLGibbs]

Specify the range to copy... rFound.Offset(,1).Resize(1,20).Copy

Would , for example, move one column to the right of the rFound cell, then resize to 1 row and 20 columns from there to copy that data to the location.

[AlexAlexon]

It works!!!!
XL gibbs and xld thanks very much!