Copier/coller et regroupe selon une valeur

Sub Macro1()
    Dim y As Long
    Dim compteur1 As Long, compteur2 As Long, compteur3 As Long
    
    compteur1 = 6
    compteur2 = 6
    compteur3 = 6
    
    For y = 3 To Cells(Rows.Count, 1).End(xlUp).Row
        Select Case Cells(y, 1)
            Case "Groupe 1":
                compteur1 = compteur1 + 1
                Cells(compteur1, 6) = Cells(y, 2)
            Case "Groupe 2":
                compteur2 = compteur2 + 1
                Cells(compteur2, 7) = Cells(y, 2)
            Case "Groupe 3":
                compteur3 = compteur3 + 1
                Cells(compteur3, 8) = Cells(y, 2)
        End Select
    Next y
End Sub

Option Explicit

Sub Macro2()
    Dim y As Long, x As Long
    Dim tableau() As String
    Dim compteurY As Long
    Dim compteurX As Long
    Dim colonne As Integer
    Dim nextLoc As Long
    
    ' On trie la feuille dans l'ordre croissant de la colonne A
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
    ' on met dans le tableau tous les groupes trouvés
    For y = 100 To 2 Step -1
        If Cells(y, 1) <> "" Then
            If Cells(y, 1) <> Cells(y - 1, 1) Then
                compteurY = compteurY + 1
                ReDim Preserve tableau(compteurY)
                tableau(compteurY) = Cells(y, 1)
            End If
        End If
    Next y
    
    compteurX = 5
    For x = UBound(tableau) To 1 Step -1
        compteurX = compteurX + 1
        With Cells(6, compteurX)
        .Value = tableau(x)
        .Font.Size = 11
        .Font.Bold = True
        .HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
        .Borders.Weight = xlThin
        End With
    Next x

    compteurX = UBound(tableau) + 1
    colonne = 5
    Do
        compteurX = compteurX - 1
        colonne = colonne + 1
        For y = 2 To 100
            If Cells(y, 1) = tableau(compteurX) Then
                nextLoc = Cells(Rows.Count, colonne).End(xlUp).Row + 1
                With Cells(nextLoc, colonne)
                .Value = Cells(y, 2)
                .Font.Size = 11
                .Font.Bold = False
                .HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
                .Borders.Weight = xlThin
                End With
            End If
        Next y
    Loop Until compteurX = 1
    Cells(1, 1).Select
    
End Sub