Microsoft 365 Intégrer plusieurs cellules à partir d'un nom.

Sub Importer()
    Dim f, DL%, DLD%, i%
    [A2:P10000].ClearContents
    Application.ScreenUpdating = False
    Set f = Sheets("ETAT_DU_FICHIER")
    DL = f.Range("A65500").End(xlUp).Row
    DLD = DL - 1 ' Car on commence en ligne 3 mais on colle en ligne 2
    ' Remise en ordre des colonnes
    Range("A2:E" & DLD) = f.Range("K3:O" & DL).Value
    Range("F2:F" & DLD) = f.Range("A3:A" & DL).Value
    Range("G2:G" & DLD) = f.Range("C3:C" & DL).Value
    Range("H2:H" & DLD) = f.Range("G3:G" & DL).Value
    Range("I2:K" & DLD) = f.Range("D3:F" & DL).Value
    Range("L2:L" & DLD) = f.Range("I3:I" & DL).Value
    Range("M2:M" & DLD) = f.Range("H3:H" & DL).Value
    Range("N2:P" & DLD) = f.Range("P3:R" & DL).Value
    Columns.AutoFit
    ' Suppression des Noms identiques
    For i = DLD To 2 Step -1
        If Cells(i, "A") = Cells(i - 1, "A") And Cells(i, "B") = Cells(i - 1, "B") And Cells(i, "C") = Cells(i - 1, "C") Then
            ' Si nom Prénom Portable identiques on efface
            Range(Cells(i, "A"), Cells(i, "E")).ClearContents
        End If
    Next i
End Sub