Sub Macro2()
Dim Feuille As Worksheet, I As Integer
With Sheets("TRACKER")
For Each Feuille In ThisWorkbook.Worksheets
If Feuille.Name <> "TRACKER" Then
Feuille.Cells.Clear
.Rows(1).Copy Feuille.Rows(1)
End If
Next Feuille
On Error Resume Next
For I = 2 To .Range("A" & Rows.Count).End(xlUp).Row
.Rows(I).Copy Sheets(Trim(UCase(.Cells(I, 4)))).Range("A" & Sheets(Trim(UCase(.Cells(I, 4)))).Range("A" & Rows.Count).End(xlUp).Row + 1).EntireRow
.Rows(I).Copy Sheets(Trim(UCase(.Cells(I, 5)))).Range("A" & Sheets(Trim(UCase(.Cells(I, 5)))).Range("A" & Rows.Count).End(xlUp).Row + 1).EntireRow
.Rows(I).Copy Sheets(Trim(UCase(.Cells(I, 6)))).Range("A" & Sheets(Trim(UCase(.Cells(I, 6)))).Range("A" & Rows.Count).End(xlUp).Row + 1).EntireRow
Next I
On Error GoTo 0
End With
End Sub