try this:
Sub blah()
Dim Uniques As New Collection
If Not ActiveSheet.AutoFilter Is Nothing Then ActiveSheet.AutoFilter.Range.AutoFilter
Set SourceData = Range("A1").CurrentRegion
SourceData.AutoFilter
On Error Resume Next
For Each cll In SourceData.Columns(3).Offset(1).Resize(SourceData.Rows.Count - 1).Cells
Uniques.Add cll.Value, cll.Value
Next cll
On Error GoTo here
With SourceData
DestColm = 6
Application.ScreenUpdating = False
For Each itm In Uniques
.AutoFilter Field:=3, Criteria1:=itm
SourceData.Copy Cells(1, DestColm)
DestColm = DestColm + 3
Next itm
End With
SourceData.AutoFilter
here:
Application.ScreenUpdating = True
End Sub
The above code is in the attached. On sheet2 there is a button, click it to run the above code to satisfy yourself that it works then adapt it for your needs.