Copy rows to different sheets

[John Smith]

Hi,

I hope someone can help with this, as I've tried to solve it myself &
failed.

I have a spreadsheet with a (sorted) list in sheet1 (the number of
rows will vary from time to time but would have a maximum of 8,000). I
want to copy the entire row to another sheet in the workbook if the
data in row “b” a certain value.

For example row b could have “Value1”, “Value2”, “Value3” etc. (Max of
20 different values) and I would like to copy the row with the
matching value to sheets names “Value1”, Value2”.

I hope I have explained everything & thanks in advance for all
assistance.

Regards

John

 

[Mike H]

Hi,

Right click the sheet tab with the data in, view code and paste the code
below in. It currently copies to sheet 3 so change to suit

Sub Sonic()
Dim R As Range, copyrange As Range
Dim V As Variant
Dim S As String
lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
S = "aaa,bbb" 'Put your values here
V = Split(S, ",")
For Each R In Range("B1:B" & lastrow)
If Not IsError(Application.Match(CStr(R.Value), V, 0)) Then
If copyrange Is Nothing Then
Set copyrange = R.EntireRow
Else
Set copyrange = Union(copyrange, R.EntireRow)
End If
End If
Next R
If Not copyrange Is Nothing Then
copyrange.Copy Destination:=Sheets("Sheet3").Range("A1")
End If

End Sub

Mike