try again autofilter:

Sub Test()
Dim LCol As Long, LRow As Long, i As Long
Dim myRng As Range

Application.ScreenUpdating = False

With ActiveSheet
LCol = .Cells(1, Columns.Count).End(xlToLeft).Column
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set myRng = .Range(.Cells(1, 1), .Cells(LRow, LCol))

For i = 4 To LCol
myRng.AutoFilter Field:=i, Criteria1:="<"
.Range(.Cells(2, 1), .Cells(LRow, 3)).SpecialCells(xlCellTypeVisible).Copy _
Sheets(.Cells(1, i).Value).Cells(Rows.Count, 1).End(xlUp)(2)
.ShowAllData
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--

Well, that is a work of art. Autofilter to the rescue again, and of course the excellent knowledge to use it.

Thanks Claus.

Howard