Copier lignes vers une autre feuille, sous condition

[fahki]

Bonjour à tous,

J'ai un petit problème sur Excel 2010, je vous explique :

J'ai une feuille "ExportVP" qui contient plusieurs événements par numéro de série.
Grâce à une macro très simple de mon cru, je récupère les numéros de série situés dans la feuille "Export VP" pour les mettre dans une nouvelle feuille, appelée "Numero de serie", pour enlever les doublons. Tout ça est OK, cela se complique à partir de maintenant :

Je souhaiterais afficher dans une nouvelle feuille tous les événements par numéro de série.

Voici mon code :

Sub Macros()
Call Copie_ExportVP
Call Supp_lignes
Call Doublons
End Sub


Sub Copie_ExportVP()
Sheets("exportVP").Select
    Sheets("exportVP").Copy After:=Sheets(1)
Exit Sub
End Sub


Sub Supp_lignes()
Dim I As Integer
Sheets("exportVP (2)").Select
For I = Range("H6000").End(xlUp).Row To 1 Step -1
        If Cells(I, 8) = "" Then
           Rows(I).Delete
        End If
Next I
Exit Sub
End Sub


Sub Doublons()

    Sheets.Add After:=Sheets(Sheets.Count) 'Création nouvelle feuille
ActiveSheet.Name = Sheets("ExportVP").Range("n1").Value       'Toujours le même nom "Numéro de série"
    Sheets("exportVP (2)").Select
    Range("N1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy                         'Copier tous les numéros de série
    Sheets("Numero de serie").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$A$6000").RemoveDuplicates Columns:=1, Header:=xlNo 'Suppression des doublons
    Range("A2").Select
End Sub

Sub SN_Evenements()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim plo As Range 'déclare la variable pl (PLage Origine)
Dim plc As Range 'déclare la variable pl c (PLage Cible)
Dim R As Range 'déclare la variable r (Recherche)

Sheets.Add After:=Sheets(Sheets.Count) 'Création nouvelle feuille
ActiveSheet.Name = Sheets("ExportVP").Range("H1").Value       'Toujours le même nom "Materiel"
Set plo = Sheets("Numero de serie").Range("A1:A" & Range("A6000").End(xlUp).Row) 'définit la plage plo
Set plc = Sheets("exportVP (2)").Range("N1:N" & Range("N6000").End(xlUp).Row) 'définit la plage plc
For Each cel In plo 'boucle sur toutesles cellules éditées cel de la plage plo
    Set R = plc.Find(cel, , xlValues, xlWhole) 'définit la variable r (recherche la valeur de la cellule dans la plage cible)
    If Not R Is Nothing Then 'condition : si il existe au moins une occurrence de r dans la plage cible
        cel.Offset(0, 1).Insert Shift:=xlDown 'insère un cellule vide dans la cellule adjacente à cel
        R.Cut cel.Offset(0, 1) 'coupe et colle l'occurence trouvée
    End If 'fin de la connexion
Next cel 'prochaine cellule de la boucle
End Sub

Je vous joins mon fichier. Bon courage à tous et merci par avance de votre aide!
Guillaume

 

[Yaloo]

Re : Copier lignes vers une autre feuille, sous condition

Bonsoir fahki,

C'est trop confus, on ne sais pas ce qu'il faut faire exactement.

Il faudrait que tu mettes de quel endroit tu pars et où tu veux arriver. Avec des exemples, des couleurs etc...

A+

Martial