Trier et exporter des données en VBA

Version imprimable

23/01/2013, 16h19
nesta09

Trier et exporter des données en VBA

Bonjour,

voici mon problème,

Dans une premiere feuille nommée "feuil1" j'ai dans la colonne B des noms d'appareils; j'aimerai pouvoir, dans une autre feuille nommée "feuil2" récupérer toutes les lignes qui contiennent le même nom d'appareil et les copiers dedans (juste en cliquant sur un bouton si possible). Il me faudrait une feuille différente pour chaque appareils ayant un nom différent.

Je suis plus que débutant en VBA et donc j'ai beaucoup de mal,
merci d'avance pour votre aide

Bonjour,

J'ai supposé que les feuilles n'étaient pas créées. La macro utilise un dictionnaire pour éliminer les doublons et un filtre automatique pour sélectionner les appareils :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Nesta09()
    Dim Plage As Range, Dico As Object, C As Range, Sh As Worksheet
    Set Dico = CreateObject("Scripting.Dictionary")
    With Sheets("Feuil1")
        Set Plage = .Range(.[B2], .Cells(.Rows.Count, 2).End(xlUp))
        For Each C In Plage
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
            End If
        Next C
        For Each Item In Dico.items
            Set Plage = .Range(.[B1], .Cells(.Rows.Count, 2).End(xlUp))
            .AutoFilterMode = False
            Plage.AutoFilter 1, Item
            Set Plage = Plage.SpecialCells(xlCellTypeVisible).EntireRow
            Set Sh = Sheets.Add(after:=Sheets(Sheets.Count))
            Sh.Name = Item
            Plage.Copy Sh.[A1]
        Next Item
        .AutoFilterMode = False
    End With
End Sub

N'hésite pas à poser des questions.

24/01/2013, 09h26
nesta09

Merci infiniment ton code marche parfaitement et j'ai reussi à le comprendre, c'est parfait pour moi, je pouvais pas avoir mieux je crois, merci encore.

Bonjour,

finalement j'ai parlé un peu trop vite le code marche bien mais si je change la colonne de recherche et le nom de la feuille de depart (renomée ECR) j'ai une erreur qui survient à ce niveau : Sh.Name = Item (erreur 1004) je ne comprends pas pourquoi... dans mon véritable tableau les noms des appareils commence à la colonne AK17 avant se sont les intitulés.

merci de votre aide

Je peux envoyer le fichier si besoin...
24/01/2013, 10h32
Daniel.C

Bonjour,

Oui, mets-le en pièce jointe; efface au préalable les données confidentielles.
24/01/2013, 11h28
nesta09

1 pièce(s) jointe(s)

Pièce jointe 110060

voila ma feuille, les données sont fausses, les noms des appareils a trier sont dans la colonne AK (du type LLB LLC ...).

merci

Voici la macro modifiée :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Nesta09()
    Dim Plage As Range, Dico As Object, C As Range, Sh As Worksheet
    Set Dico = CreateObject("Scripting.Dictionary")
    With Sheets("ECR")
        Set Plage = .Range(.[K17], .Cells(.Rows.Count, 11).End(xlUp))
        For Each C In Plage
            If Not Dico.exists(C.Value) Then
                If C.Value <> "" Then Dico.Add C.Value, C.Value
            End If
        Next C
        For Each Item In Dico.items
            Set Plage = .Range(.[K17], .Cells(.Rows.Count, 11).End(xlUp))
            .AutoFilterMode = False
            Plage.AutoFilter 1, Item
            Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1)
            Set Plage = Plage.SpecialCells(xlCellTypeVisible).EntireRow
            Set Sh = Sheets.Add(after:=Sheets(Sheets.Count))
            Sh.Name = Item
            Plage.Copy Sh.[A1]
        Next Item
        .AutoFilterMode = False
    End With
End Sub

24/01/2013, 16h23
nesta09

merci pour le nouveau code, les appareils a trier sont en faite dans la colonne AK mais ça j'arrive à m'en sortir pour le changer; cependant j'ai toujours une erreur mais sur cette ligne maintenent:

Code:

Set Plage = Plage.SpecialCells(xlCellTypeVisible).EntireRow

(toujours erreur 1004).

Ce qui empèche la macro d'aller jusqu'a la fin je pense puisque tout mes appareils ne ce listent pas, seulement une partie.

Au temps pour moi... On va y arriver :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Nesta09()
    Dim Plage As Range, Dico As Object, C As Range, Sh As Worksheet
    Set Dico = CreateObject("Scripting.Dictionary")
    With Sheets("ECR")
        Set Plage = .Range(.[AK17], .Cells(.Rows.Count, "AK").End(xlUp))
        For Each C In Plage
            If Not Dico.exists(C.Value) Then
                If C.Value <> "" Then Dico.Add C.Value, C.Value
            End If
        Next C
        For Each Item In Dico.items
            .AutoFilterMode = False
            Set Plage = .Range(.[AK17], .Cells(.Rows.Count, "AK").End(xlUp))
            Plage.AutoFilter 1, Item
            Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1)
            Var = Plage.Address
            Set Plage = Plage.SpecialCells(xlCellTypeVisible).EntireRow
            Set Sh = Sheets.Add(after:=Sheets(Sheets.Count))
            Sh.Name = Item
            Plage.Copy Sh.[A1]
        Next Item
        .AutoFilterMode = False
    End With
End Sub

25/01/2013, 10h14
nesta09
Merci beaucoup pour ton code celui-ci marche parfaitement, mais j'ai encore une question, j'aurai aimé rajouter mon entete au haut des feuilles j'ai donc modifié la premier ligne de copie qui était en A1 mais je ne sais pas comment retrouver chaques nouvelles feuilles créees.
Code:

1 2 3 4 5 6 7 Range("A12:AX14").Select Range("AX12").Activate Application.CutCopyMode = False Selection.Copy Sheets("sh").Select ActiveSheet.Paste Rows("3:3").RowHeight = 78.75
j'ai essayé ça mais le "SH" ne fonctionne pas pour retrouver mes nouvelles feuilles,de plus je ne vois pas ou je dois rajouter ce code dans ta macro de depart.

merci pour ton aide.

Bonjour,

Je n'ai pas compris d'où venait le "78.75". Change les hauteurs de ligne si ce que j'ai miis n'est pas correct (j'ai repris celles de la feuille ECR).

Code:

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
27
28
Sub Nesta09()
    Dim Plage As Range, Dico As Object, C As Range, Sh As Worksheet
    Set Dico = CreateObject("Scripting.Dictionary")
    With Sheets("ECR")
        Set Plage = .Range(.[AK17], .Cells(.Rows.Count, "AK").End(xlUp))
        For Each C In Plage
            If Not Dico.exists(C.Value) Then
                If C.Value <> "" Then Dico.Add C.Value, C.Value
            End If
        Next C
        For Each Item In Dico.items
            .AutoFilterMode = False
            Set Plage = .Range(.[AK17], .Cells(.Rows.Count, "AK").End(xlUp))
            Plage.AutoFilter 1, Item
            Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1)
            Var = Plage.Address
            Set Plage = Plage.SpecialCells(xlCellTypeVisible).EntireRow
            Set Sh = Sheets.Add(after:=Sheets(Sheets.Count))
            Sh.Name = Item
            .[A12:AX14].Copy Sh.[A1]
            Sh.[1:1].RowHeight = 26.25
            Sh.[2:2].RowHeight = 133.5
            Sh.[3:3].RowHeight = 24
            Plage.Copy Sh.[A4]
        Next Item
        .AutoFilterMode = False
    End With
End Sub

25/01/2013, 10h51
nesta09

le 75 était la hauteur de la colonne que j'avais modifier un peu aléatoirement mais ton code marche très bien une fois encore, c'est exactement ce qu'il me fallait merci.

J'ai une derniere question, si je dois crée une nouvelle macro qui utiliserait ses nouvelles feuilles est ce que je peux simplement les retrouver en utilisant le terme SH? ou il faut encore un nouveau code pour les identifiers et les utiliser? (pour faire des calculs automatiques par exemple).
25/01/2013, 11h07
Daniel.C
La variable "Sh" est affectée à la feuille qui vient d'être crée :

Code:

Set Sh = Sheets.Add(after:=Sheets(Sheets.Count))

Elle représente cette feuille et donc tu peux t'en servir jusqu'à ce que la boucle :
Code:

1 2 3 Set Sh = Sheets.Add(after:=Sheets(Sheets.Count)) ... Next Item
repasse sur cette instruction et affecte "Sh" à une nouvelle feuille. Concrètement, jusqu'à :

Code:

Next Item
25/01/2013, 11h14
nesta09

Ok ok j'ai bien tout compris, en tout cas merci beaucoup pour ton aide Daniel tu m'as grandement simplifié la vie (et pas qu'à moi je pense).

A une prochaine fois peut etre, et merci encore à toi, tu as résolu tout mes problèmes:ccool: