Copier/coller et regroupe selon une valeur

[niwiz]

Bonjour,

Donc cela fait deja plusieurs heures que je me vois bloqué. en effet je souhait faire un recopier d'une plage dans une autres plages et en le restructurant differement.

Regrouper les noms groupes selon un groupe

groupe 1 : nom 1
groupe 1 : nom 2

resultat rechercher= >

groupe 1
_______
nom 1
nom 2

Pour etre plus clair, voici ci joint le fichier avec les detailles.

merci beaucoup de m'eclairer sur la marche à suivre pour y parvenir.

Cordialement pierre.

 

[Dormeur74]

Re : Copier/coller et regroupe selon une valeur

Cette petite macro devrait faire l'affaire :

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

 

[niwiz]

Re : Copier/coller et regroupe selon une valeur

Merci Dormeur74 pour ta reponse qui est effectivement correct et qui m'aide bcp 🙂

Mais j'aimerais que cela soit dynamique. En effet il peut y avoir plus de groupe( groupe 4 , groupe 5 etc...). et il faudrais donc les ajouter à la suite (I7,I8,etc...).

merci d'avance

Merci

 

[Dormeur74]

Re : Copier/coller et regroupe selon une valeur

Tu aurais dû envoyer toute la sauce en même temps. Bon, je vois ça.

 

[Dormeur74]

Re : Copier/coller et regroupe selon une valeur

Il n'y avait pas grand-chose à ajouter.

 

[niwiz]

Re : Copier/coller et regroupe selon une valeur

C'est ce qu'il me fallait !!

Merci beaucoup dormeur74 pour ton aide et pour le tps que tu m'as accordé 🙂

 

[Efgé]

Re : Copier/coller et regroupe selon une valeur

Bonjour niwiz, Dormeur, Juste pour le plaisir, une autre version. Cordialement

 

[niwiz]

Re : Copier/coller et regroupe selon une valeur

Dernière petite question, comment faire pour que le Cells(Rows.Count, 1).End(xlUp).Row commence a A100 et aille jusqu'a A2?
qu 'il ne prenne en compte que la plage A2 a A100 ?

merci d'avance 🙂

 

[niwiz]

Re : Copier/coller et regroupe selon une valeur

Apparemment Cells(Range("D3😀100").Count, 4).End(xlUp).Row fonctionne!!

 

[Dormeur74]

Re : Copier/coller et regroupe selon une valeur

Juste une petite précision :
On ne peut pas faire un tri initial sur les colonnes A et B, car Nom 11 passera avant Nom 2 en classement alphanumérique. Mieux vaudrait formater la colonne B pour avoir Nom 02 au lieu de Nom 2.

Pour aller de 100 à 2 (dans le dur), tu peux toujours modifier la macro comme suit :

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

 

[niwiz]

Re : Copier/coller et regroupe selon une valeur

C'est encore moi !!

J'ai une nouvelle problématique. J'aimerai nommer chaque plage par le titre

ex :
F7:F16 names => F6
G7:G12 names => G6
etc ...

j'ai essayé quelque chose mais malheureusement probleme de synthaxe et/ou je ne le place pas au bonne endroits

compteurX = 0
Do
compteurX = compteurX + 1
For y = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(y, 1) = tableau(compteurX) Then
NextLoc = Cells(Rows.Count, compteurX + 5).End(xlUp).Row + 1

'nomGrp = Cells(6, compteurX + 5).Value
'ActiveWorkbook.Names(nomGrp).Delete

With Cells(NextLoc, compteurX + 5)
.Value = Cells(y, 2)
.Font.Size = 11
.Font.Bold = False
.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.Borders.Weight = xlThin
End With
End If

'ActiveWorkbook.Names.Add Name:=nomGrp, RefersToR1C1:= _
'"=saisie_charge!Range(cells(7,compteurX + 5),cells(100, compteurX + 5).End(xlUp).Row))"

Next y
Loop Until compteurX = UBound(tableau)

Dsl de vous solliciter à nouveau et merci d'avance

 

[niwiz]

Re : Copier/coller et regroupe selon une valeur

J'ai avancé mais je reste toujours bloqué sur la syntaxe !

Quelqu'un pour me débloquer sur la partie en gras ?

compteurX = 0
Do
Dim nomGrp As String
compteurX = compteurX + 1
For y = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(y, 1) = tableau(compteurX) Then
NextLoc = Cells(Rows.Count, compteurX + 5).End(xlUp).Row + 1

With Cells(NextLoc, compteurX + 5)
.Value = Cells(y, 2)
.Font.Size = 11
.Font.Bold = False
.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.Borders.Weight = xlThin
End With

End If
Next y
nomGrp = Replace(Cells(6, compteurX + 5).Value, " ", "_")
MsgBox nomGrp
For Each n In ActiveSheet.Names
If n = nomGrp Then
n.Delete
End If
Next
ActiveWorkbook.Names.Add Name:=nomGrp, RefersToR1C1:="=Feuil1!Range(Cells(7, compteurX + 5), Cells(100, compteurX + 5).End(xlUp))"

Loop Until compteurX = UBound(tableau)

j'ai l'impression que le delete ne fonctionne pas et que la syntaxe du names.Add est incorrect

Merci d'avance 🙂

 

[niwiz]

Re : Copier/coller et regroupe selon une valeur

Apres moult recherche j'ai enfin trouver ^^

faut juste remplace ce qu'il y a apres le delete par
=> ActiveWorkbook.Worksheets("Feuil1").Range(Cells(7, compteurX + 5), Cells(100, compteurX + 5).End(xlUp)).Name = nomGrp

merci bcp dsl pour le dérangement