Un tableau automatique

Sub TrieDonnées()
' Macro enregistrée par Excel-lent

Dim NbDeLigneFeuil1 As Long
Dim NumLigneFeuil2 As Long
Dim Batiment As String
Dim Facade As String
Dim Etage As String

Sheets("Feuil2").Select

With Sheets("Feuil1")
   NbDeLigne = .[A65536].End(xlUp).Row
   NumLigneFeuil2 = 2
   
   For i = 1 To NbDeLigne
     If [COLOR="Blue"].Cells(i, 1).Font.ColorIndex = [B]5[/B][/COLOR] Then
         Batiment = .Cells(i, 1)
     ElseIf [COLOR="Blue"].Cells(i, 1).Font.ColorIndex = [B]3[/B][/COLOR] Then Facade = .Cells(i, 1)
     ElseIf [COLOR="Blue"].Cells(i, 1).Font.ColorIndex = [B]50[/B][/COLOR] Then Etage = .Cells(i, 1)
     Else
         Cells(NumLigneFeuil2, 1) = Batiment
         Cells(NumLigneFeuil2, 2) = Facade
         Cells(NumLigneFeuil2, 3) = Etage
         Cells(NumLigneFeuil2, 4) = .Cells(i, 1)
         Cells(NumLigneFeuil2, 5) = .Cells(i, 5)
         Cells(NumLigneFeuil2, 6) = .Cells(i, 6)
         NumLigneFeuil2 = NumLigneFeuil2 + 1
     End If
   Next i
End With
Rows("2:3").Delete
End Sub