give this a try
Sub filtercopy()
Dim sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim r As Integer, s As Integer, t As Integer, u As Integer
Dim lastrow As Integer
Set sh = ThisWorkbook.Sheets("Sheet1")
Set sh2 = ThisWorkbook.Sheets("Sheet3")
lastrow = sh.Cells(Rows.Count, "b").End(xlUp).Row
r = 2
s = 2
t = 2
u = 2
sh2.Range("A1").Value = "Case Group 1"
sh2.Range("L1").Value = "Case Group 2"
sh2.Range("X1").Value = "Case Group 3"
For r = 2 To lastrow
If sh.Range("b" & r) = "1" Then
sh.Range("c" & r & ":j" & r).Copy _
Destination:=sh2.Range("A" & s)
s = s + 1
End If
If sh.Range("b" & r) = "2" Then
sh.Range("c" & r & ":j" & r).Copy _
Destination:=sh2.Range("l" & t)
t = t + 1
End If
If sh.Range("b" & r) = "3" Then
sh.Range("c" & r & ":j" & r).Copy _
Destination:=sh2.Range("x" & u)
u = u + 1
End If
Next r
End Sub
Bookmarks