Sub Regroupe()
Dim col%, w As Worksheet, n%, nom As Range, sup As Range
Application.ScreenUpdating = False
With Feuil1 'CodeName
col = 3 '1ère colonne vide en Feuil1, à adapter
.Range(.Columns(col), .Columns(.Columns.Count)).Delete
.Cells.Sort .Rows(1).Find("Nom", , xlValues), Header:=xlYes
For Each w In Worksheets
If w.CodeName <> .CodeName Then
n = w.Cells(1, .Columns.Count).End(xlToLeft).Column
With .Columns(col).Resize(, n)
w.[A:A].Resize(, n).Copy .Cells
Set nom = .Rows(1).Find("Nom")
.Sort nom, Header:=xlYes 'tri sur le nom
End With
Set sup = Union(nom, IIf(sup Is Nothing, nom, sup))
col = col + n
End If
Next
sup.EntireColumn.Delete 'suppression des colonnes des noms
.Cells.Sort .[A1], Header:=xlYes 'tri sur colonne A
.Activate 'facultatif
End With
End Sub