Sub Test()
Dim i As Long, F As Worksheet
With Sheets("LISTING")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 8).Value <> "" Then
On Error Resume Next
Set F = Sheets(.Cells(i, 8).Value)
If Err Then
Err.Clear
Sheets.Add(after:=Sheets(Sheets.Count)).Name = .Cells(i, 8).Value
Set F = Sheets(.Cells(i, 8).Value)
.Range("A1:C1").Copy F.Cells(1, 1)
End If
.Range("A" & i & ":C" & i).Copy F.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next i
.Activate
End With
End Sub