Discussion :

[nomade333]

Bonjour,
J’ai une feuille Excel (Feuil1) sur laquelle je voudrais faire un regroupement sur une colonne (la colonne D de mon fichier)
En fait dans cette colonne il y a une cellule dans laquelle figure un numéro qui se retrouve réguliérement dans d’autres cellule de la même colonne et c’est sur ce numéro que je voudrais faire un regroupement pour obtenir en final les données de la feuil2.
Merci par avance de votre aide

[gFZT82]

Bonjour,

Tu peux commencer avec ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Option Explicit
Sub Regroupement()
Dim DerLig1 As Long, DerLig2 As Long
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Cel As Range, MaPlage As Range
Dim Valeur As String, Message As String, Titre As String, Defaut As String
 
    Set Ws1 = Worksheets("Feuil1")
    Set Ws2 = Worksheets("Feuil2")
    DerLig1 = Ws1.Range("D" & Ws1.Rows.Count).End(xlUp).Row
    DerLig2 = Ws2.Range("E" & Ws2.Rows.Count).End(xlUp).Row
    Set MaPlage = Ws1.Range("D8:D" & DerLig1)
 
    Message = "Entrez la valeur UBIC."
    Titre = "Regroupement"
    Defaut = "60004"
    Valeur = InputBox(Message, Titre, Defaut)
 
    For Each Cel In MaPlage
        If Ws1.Range("D" & Cel.Row) = Valeur Then
            Ws1.Range(Cells(Cel.Row, "A"), Cells(Cel.Row, "L")).Copy Destination:=Ws2.Range("B" & DerLig2 + 1)
            DerLig2 = DerLig2 + 1
        End If
    Next
End Sub

Cordialement.

[nomade333]

Bonjour,
Génial je te remercie.
A+

Bonsoir
Si je rajoute une colonne à Feuil1 cela ne fonctionne plus?
Merci par avance

[gFZT82]

La recherche est effectuée dans la colonne D.
On compare chacune des valeurs des cellules de cette colonne avec la valeur recherchée.
Si tu rajoutes une colonne à gauche, la plage de recherche est déplacée de D en E.
Les 2 lignes de codes suivantes doivent être modifiées.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
DerLig1 = Ws1.Range("E" & Ws1.Rows.Count).End(xlUp).Row
Set MaPlage = Ws1.Range("E8:E" & DerLig1)

Cordialement.

[nomade333]

Bonjour et merci encore.