Discussion :

[thib.gueraud]

Bonjour tout le monde,

J'aimerais créer une nouvelle feuille à chaque tri effectué, avec les données des 3 colonnes copiées dans la nouvelle feuille.



J'ai réussi à faire un module seulement pour obtenir ce que je veux pour "Ambassade de Bretagne", mais j'aimerais qu'à la fin de celui-ci, le module poursuive sur "Anticafé Beaubourg" et ainsi de suite, afin de créer autant de feuille qu'il y a de nom de restaurants différents dans la colonne C. :

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
Sub creafeuille()
'
' creafeuille Macro
'
 
'
    ActiveSheet.Range("$A$1:$C$41979").AutoFilter Field:=3, Criteria1:= _
        "Ambassade de Bretagne"
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    Sheets.Add
    ActiveSheet.Paste
    ActiveSheet.Name = Range("C2").Text
End Sub

Je pense qu'il faut que je fasse une sorte de loop, mais je ne maitrise malheureusement que les loops avec des nombres entiers.

Quelqu'un aurait des tips ?

Merci

[Thautheme]

Bonjour Thib, bonjour le forum,

Essaie comme ça :

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
29
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (incrément)
 
Set OS = Worksheets("Feuil1") 'définit l'onglet source OS (à adapter à ton cas)
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If Not D.exists(TV(I, 3)) Then 'condition 1 : si la clé n'existe pas dans le dictionnaire
        D.Add TV(I, 3), I 'ajoute la clé au dictionnaire
        On Error Resume Next 'gestion des erreurs (en cas d'erreur passe a la ligne suivante)
        Set OD = Worksheets(TV(I, 3)) 'définit l'onglet destination OD (génère une erreur si l'onglet n'existe pas)
        If Err <> 0 Then 'condition 2 : si un erreur a été générée
            Err.Clear 'supprime l'erreur
            Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet en dernière position
            Set OD = ActiveSheet 'définit l'onglet destination OD
            OD.Name = TV(I, 3) 'renomme l'onglet
        End If 'fin de la condition 2
        On Error GoTo 0 'annule la gestion des erreurs
        OD.Cells.ClearContents 'efface le contenu de l'onglet destinatin (au cas où...)
        OS.Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:=TV(I, 3) 'filtre l'onglet source avec la donnée ligne I colonne 3
        OS.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy OD.Range("A1") 'copie les cellules visibles et le colle dans A1 de l'onglet destination
        OS.Range("A1").CurrentRegion.AutoFilter 'supprime le filtre automatique
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
End Sub

[Menhir]

Je pense qu'il faut que je fasse une sorte de loop, mais je ne maitrise malheureusement que les loops avec des nombres entiers.

Je te conseille de lire ceci : http://silkyroad.developpez.com/vba/boucles/

[thib.gueraud]

Hello Thauthème

Merci pour ta réponse

J'ai quelques questions :

Je ne comprends pas trop à quoi correspondent les lignes suivantes :

Code :

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

1
2
3
4
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If Not D.exists(TV(I, 3)) Then 'condition 1 : si la clé n'existe pas dans le dictionnaire
        D.Add TV(I, 3), I 'ajoute la clé au dictionnaire

D'autant plus qu'un message d'erreur s'affiche dès la lecture de la ligne Set D = ...



J'ai cherché de quelle manière résoudre ce problème, en vain.

Merci beaucoup

[Thautheme]

Re,

J'ai ce genre de message quand j'orthographie mal : Scripting.Dictionary. J'ai testé le code sur un fichier avant de te l'envoyé. Je n'ai pas eu de message d'erreur et le résultat correspondait à ta requête... L'utilisation d'un objet Dictionary permet, entre autre, d'éviter les doublons...