Sub copier()
Dim Cel As Range 'Variables
Dim myRange As Range
Dim Ligne As Integer
Set myRange = Range("Y2:Y40") 'Plage où la condition "x" est rentrée
Ligne = Sheets("Feuil2").Range("A65536").End(xlUp).Row 'Détermine la ligne où commencer la macro
For Each Cel In myRange 'Boucle sur les cellules de la colonne Y
If Cel.Value = "x" Then 'Vérifie que la case Y = x
Ligne = Ligne + 1 'Ligne où copier +1 (Renvoie la ligne de la première cellule non-vide de la colonne A
Absc = Cel.Row 'Numéro de ligne pour laquelle la condition est vérifiée
Ordo = Cel.Column 'Numéro de colonne pour laquelle la condition est vérifiée
Dim i& 'Boucle sur le nombre de colonne de ton tableau d'origine
For i = 1 To 24 Step 1 'Colonne A à X de ta première feuille où se trouve le tableau source
Dim j&
For j = 1 To 24 ' Colonne de A à X içi mais modifiable selon le nombre de colonnes souhaitées [Toujours l'intitulé en première ligne]
If Cells(1, i).Value = Sheets("Feuil2").Cells(1, j).Value Then 'Vérifie que l'intitulé de la première colonne correspond à
Sheets("Feuil2").Cells(Ligne, j).Value = Cells(Absc, i).Value 'Toutes les colonnes ayant le bon intitulé reçoivent la valeur correspondante sous réverse que la première condition soit validée
Cells(Absc, i).Copy
Sheets("Feuil2").Cells(Ligne, j).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Next j
Next i
Sheets("Feuil2").Cells(Ligne, 26).Value = Cells(Absc, Ordo).Value & Absc ' Renvoie le "x" et le numéro de la ligne en feuil1 enlever le "& Absc" pour rajouter uniquement les "x"
End If
Next Cel
End Sub