Microsoft 365 Créer autant d'onglet que de commune dans ma base principale

[cocro]

Bonjour,

il m'est demandé de faire une extraction commune par commune des informations de ma base de données.
Autant je vois le process, autant j'ai du mal à l'écrire en VBA

ma table principale = "base_histo"
mon modèle d'accueil = "Com" où je recopie les entêtes des colonnes à exporter

mon code VBA

Sub AjouteFeuillesCom()
    Application.ScreenUpdating = False
    Sheets("base_histo").Select
    DL = [A65500].End(xlUp).Row                                     ' Dernière ligne du tableau
    tablo = Range("B2:B" & DL)                                      ' Tranfert des codes communes das un array
    For C = 1 To UBound(tablo)                                      ' Pour chaque commune
        If IsError(Evaluate("=" & tablo(C, 1) & "!A1")) Then        'Si cette feuille n'existe pas alors
            Sheets("Com").Copy After:=Worksheets(Sheets.Count)      ' On duplique la feuille modèle Com à la fin
            ActiveSheet.Name = tablo(C, 1)                          ' On la renomme avec le code commune
        End If
    Next C
    Sheets("base_histo").Select
End Sub

Résultat : onglet généré mais aucune copie de données.

Que me manque-t-il ?
Merci pour votre aide
Corinne

 

[Lolote83]

Bonjour @cocro,
Voici ton fichier en retour
Au final, un seul onglet ou en saisissant le CodGeo en cellule C2, cela affiche toutes les lignes correspondantes.

Créer autant d'onglet que de commune dans ma base principale​

Quelle est l'utilité d'avoir autant d'onglet puisqu'au final, on en regarde qu'un seul à la fois
Utilisation d'une requete PQ
@+ Lolote83

 

[cocro]

Merci @Lolotte83 pour ton retour. C'est en effet une alternative à la demande qui m'est formulée

Mon collègue souhaite un onglet par commune pour

• y accéder immédiatement sans autre manipulation (sans avoir à connaitre le codegeo à taper (au pis avoir une liste déroulante ?))
• y faire des traitements basiques tjs accessibles
• envisager un export rapide

D'où mon besoin de recopier toutes les lignes concernées par codegeo dans un onglet idoine

 

[Lolote83]

Re bonjour,
Au final, j'ai rajouté la liste déroulante.
Sinon, double-clic sur une commune, rapatrie le CodGeo et lance la requête (Onglet REQUETE)

Mon collègue souhaite un onglet par commune pour

Tu peux expliquer à ton collègue ce que j'explique "Par contre, je reste persuadé que la multiplicité des onglets n'est pas utile"
@+ Lolote83

 

[cocro]

Encore merci pour cet ajout qui en effet va répondre à mon besoin immédiat.
Je vais tenter la pédagogie pour les besoins secondaires de mon collègue

Pour retranscrire ton travail dans mon espace de travail, peux-tu me préciser comment déclarer "PQ_CodGeo" car la plage de référence est dynamique selon la commune sélectionnée ?

Merci

 

[cocro]

ou pour être plus précise, comment lier toutes les entêtes de mon tableau1 (base_histo) aux colonnes "requete" ?
je visionne l'interaction en ajoutant ou supprimant des colonnes dans mon fichier exemple mais je n'arrive pas à créer la plage avec toutes les variables de mon fichier source

Manque de pratique évidente de la fonction "tableau"

 

[job75]

Bonjour cocro, TooFatBoy, Lolote83,

Une solution classique avec le filtre automatique :

Sub AjouterFeuilles()
Dim i&, d As Object, tablo, com$, F As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = Worksheets.Count To 1 Step -1
    If Worksheets.Count > 1 And Not LCase(Sheets(i).Name) Like "base*" Then Sheets(i).Delete
Next
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Worksheets(1).[A1].CurrentRegion
    tablo = .Value 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        com = tablo(i, 3)
        If Not d.exists(com) Then
            d(com) = ""
            Set F = Sheets.Add(After:=Sheets(Sheets.Count))
            F.Name = com
            .AutoFilter 3, com 'filtre automatique
            .Copy F.Cells(1) 'copier-coller
            .AutoFilter 'ôte le filtre
        End If
    Next
    .Parent.Activate '1ère feuille
End With
End Sub

A+

 

[Efgé]

Bonjour à tous
Avec 365, on peux le faire avec deux formules :
une pour la liste des des CodeGeo unique (que l'on utilise dans une lise déroulante) et une fonction Filtre.
Cordialement

 

[cocro]

Merci @job75 et @Efgé pour ces deux approches complémentaires

@job75, la macro vba répond tout à fait à sa demande .... à voir comment il gère, un fichier de 85 onglets
j'ai ajouté à mon fichier , un code pour classer les onglet par ordre alphabétique (cela facilitera la navigation)

Sub SortWorkBook()
    'Updateby20140624
    Dim xResult As VbMsgBoxResult
    xTitleId = "KutoolsforExcel"
    xResult = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) & "Clicking No will sort in Descending Order", vbYesNoCancel + vbQuestion + vbDefaultButton1, xTitleId)
    For i = 1 To Application.Sheets.Count
        For j = 1 To Application.Sheets.Count - 1
            If xResult = vbYes Then
                If UCase$(Application.Sheets(j).Name) > UCase$(Application.Sheets(j + 1).Name) Then
                    Sheets(j).Move after:=Sheets(j + 1)
                End If
                ElseIf xResult = vbNo Then
                    If UCase$(Application.Sheets(j).Name) < UCase$(Application.Sheets(j + 1).Name) Then
                        Application.Sheets(j).Move after:=Application.Sheets(j + 1)
                End If
            End If
        Next
    Next
    End Sub

@Lolote83, reste à comprendre comment déployer sur la table originale et je pourrais lui mettre la solution en main

@Efgé un filtre sur la base peut suffire dans la majeur partie des cas mais pour les demandes en cours, une copie dans un onglet propre est privilégié

Encore Merci
a+

 

[job75]

j'ai ajouté à mon fichier , un code pour classer les onglet par ordre alphabétique (cela facilitera la navigation)

Il suffit de trier la base alphabétiquement sur la colonne C avant d'exécuter la macro.

 

[Lolote83]

Re bonjour à tous.
Je ne maitrise pas beaucoup PQ (Power Query) et j'essaye de l'utiliser de plus en plus car je trouve cela très inintéressant.
Cependant, je ne sais pas comment transposer la requête du fichier transmis sur un autre fichier si ce n'est :
Je vais essayer de faire une liste des opérations a effectuer pour arriver au résultat final mais il doit y avoir plus simple.
@+ Lolote83

 

[job75]

Avec un UserForm ouvert en non modal pour naviguer entre les feuilles :

Private Sub ComboBox1_Change()
On Error Resume Next
Sheets(ComboBox1.Text).Activate
End Sub

Private Sub UserForm_Initialize()
Dim w As Worksheet
For Each w In Worksheets
    ComboBox1.AddItem w.Name
Next
End Sub

 

[job75]

Avec un UserForm, ouvert en non modal, pour naviguer entre les feuilles :

Private Sub ComboBox1_Change()
On Error Resume Next
Sheets(ComboBox1.Text).Activate
End Sub

Private Sub UserForm_Initialize()
Dim w As Worksheet
For Each w In Worksheets
    ComboBox1.AddItem w.Name
Next
End Sub

 

[cocro]

@job75 Merci pour ces améliorations. et les commentaires explicatifs qui accompagnent votre code

Je prends l'ajout du tri par ordre croissant à la création des onglets (bcq plus simple que le code que j'avais trouvé par ailleurs)

Sympa cette fenêtre qui s'ouvre en fin de macro, j'avais pensé faire un onglet "récapitulatif" des onglets existants ... avec en col A, son nom et en col B un lien pour l'ouvrir. ...si tant est que cela soit faisable aisément

petite demande d'ergonomie, peut-elle être placée à proxi du bouton "ajouter feuilles" ? et lui donner un nom explicite (Choisir sa commune) ? Cela facilitera son usage immédiat

Merci

 

[job75]

Pour le nom il suffit de modifier la propriété Caption de l'UserForm.

Pour la position c'est compliqué, il vaut mieux choisir alors le centre de l'écran.