Sub test()
Dim i&, TTmp As Variant, Tdate As Variant
Dim F As Worksheet, D As Object
Application.ScreenUpdating = False
With Sheets("Initial")
Tdate = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(3))
For i = 2 To .Cells(2, .Columns.Count).End(1).Column Step 5
TTmp = .Range(.Cells(1, i), .Cells(UBound(Tdate, 1), i + 4))
On Error Resume Next
Set F = Sheets(TTmp(1, 1))
If Err Then
Err.Clear
Sheets.Add(After:=Sheets(Sheets.Count)).Name = TTmp(1, 1)
D(TTmp(1, 1)) = ""
Set F = Sheets(TTmp(1, 1))
End If
If Not D.exists(F.Name) Then
F.Range(F.Cells(1, 1), F.Cells(F.Rows.Count, 1).End(3)(1, 6)).ClearContents
D(F.Name) = ""
End If
F.Cells(1, 1).Resize(UBound(Tdate, 1), 1) = Tdate
F.Cells(1, 2).Resize(UBound(Tdate, 1), 5) = TTmp
F.Columns.AutoFit
Next i
.Activate
End With
End Sub