Discussion :

[nesta09]

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

[Daniel.C]

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 :

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
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.

[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...

[Daniel.C]

Bonjour,

Oui, mets-le en pièce jointe; efface au préalable les données confidentielles.

[nesta09]

feuille calculs.xlsx


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

merci

[Daniel.C]

Voici la macro modifiée :

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
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

[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 :

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

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.

[Daniel.C]

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

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
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

[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 :

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

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.

[Daniel.C]

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 :

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
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

[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).

[Daniel.C]

La variable "Sh" est affectée à la feuille qui vient d'être crée :

Code :

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

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 :

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

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 :

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

Next Item

[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