Remplir une recap a partir des onglets d'un classeur

I

ingel

XLDnaute Nouveau
Bonsoir,
Je me tourne encore une fois vers vous afin de trouver une solution a mon probleme,
en effet, j'ai pu automatiser la ventilation de mon fichier (création d'onglet selon le nombre de pays présents dans la feuille nommé "rapport")
mais la je veut qu'a la fin de la ventilation, un onglet nommé "recap" se crée et qui doit contenir les noms de tous les pays (onglet crée lors de la première étape) et aussi récupérer le somme du code 1 pour chaque pays

Merci d'avance
 

Pièces jointes

  • ingel-Test -v1(2).xlsm
    28.8 KB · Affichages: 43
Trier par date Trier par votes
I

ingel

XLDnaute Nouveau
Re : Remplir une recap a partir des onglets d'un classeur

Staple1600 à dit:
Bonsoir

ingel
C'est la même question qu'ici, non ?
https://www.excel-downloads.com/threads/macro-ou-script-vba-pour-traiter-un-tableau.225218/
Et pourquoi utiliser deux pseudos ? ingel et ingelman ne font qu'un, non ?
Cliquez pour agrandir...

bonsoir,
effectivement, c'est la même question, j'ai crée une nouvelle discussion pour ne pas mélanger.
ensuite pour les pseudo, j'ai crée un deuxième car a un moment j'ai oublié le mot de passe du premier, et la je me suis mêlé les pinceaux même moi je ne m y retrouve plus.
navré pour le dérangement
 
Vote positif 0 Vote négatif
JCGL

JCGL

XLDnaute Barbatruc
Re : Remplir une recap a partir des onglets d'un classeur

Bonjour à tous,
Salut L'Agrafe,

Peux-tu essayer en remplaçant le bout de code par celui-ci :

VB: 
'affichage
    Lig = 2
    For Each pays In dico.keys
        'Test si feuille correspondant au pays existe ou non
        On Error Resume Next
        Set aux = Sheets(pays).Range("a1")
        If Err.Number > 0 Then
            'créer une nouvelle feuille
            Worksheets.Add after:=Worksheets("rapport")
            With ActiveSheet
                .Name = pays
                .Range("b3") = "Pays": .Range("c3") = pays
                .Range("b6") = "CODE": .Range("c6") = "SOMME POPULATION"
                .Cells.Interior.ColorIndex = 2
                Feuil1.Cells(Lig, 6) = pays
                Feuil1.Cells(Lig, 7).Formula = "=INDIRECT(RC[-1]&""!C7"")"
                'Feuil1.Cells(Lig, 7) = Feuil1.Cells(Lig, 7)
                Lig = Lig + 1
            End With
        End If
        On Error GoTo 0

A+ à tous
 
Vote positif 0 Vote négatif
I

ingel

XLDnaute Nouveau
Re : Remplir une recap a partir des onglets d'un classeur

JCGL à dit:
Bonjour à tous,
Salut L'Agrafe,

Peux-tu essayer en remplaçant le bout de code par celui-ci :

VB: 
'affichage
    Lig = 2
    For Each pays In dico.keys
        'Test si feuille correspondant au pays existe ou non
        On Error Resume Next
        Set aux = Sheets(pays).Range("a1")
        If Err.Number > 0 Then
            'créer une nouvelle feuille
            Worksheets.Add after:=Worksheets("rapport")
            With ActiveSheet
                .Name = pays
                .Range("b3") = "Pays": .Range("c3") = pays
                .Range("b6") = "CODE": .Range("c6") = "SOMME POPULATION"
                .Cells.Interior.ColorIndex = 2
                Feuil1.Cells(Lig, 6) = pays
                Feuil1.Cells(Lig, 7).Formula = "=INDIRECT(RC[-1]&""!C7"")"
                'Feuil1.Cells(Lig, 7) = Feuil1.Cells(Lig, 7)
                Lig = Lig + 1
            End With
        End If
        On Error GoTo 0

A+ à tous
Cliquez pour agrandir...

Bonsoir et merci,
c'est a peut prés ce que je veut, mais est ce que c'est possible d'avoir cela dans un onglet a part qui se crée une fois le ventilation fini ?
 
Vote positif 0 Vote négatif
klin89

klin89

XLDnaute Accro
Re : Remplir une recap a partir des onglets d'un classeur

Bonsoir le forum :)

Allons y pour le code 1 :
Résultat en feuille "Recap"
Le code est dans le module 3
VB: 
Sub Synthese()
'Résultat dans une autre feuille
Dim a, i As Long, j As Long, w, maxCol As Byte, n As Long, txt As String
    Application.ScreenUpdating = False
    With Sheets("rapport").Range("A1").CurrentRegion
        a = .Value: maxCol = UBound(a, 2)
        ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2))
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                'le code 1 seulement
                If a(i, 2) = 1 Then
                    txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
                    If Not .exists(txt) Then
                        .Item(txt) = VBA.Array(.Count + 2, 3)
                        For j = 1 To 3
                            a(.Item(txt)(0), j) = a(i, j)
                        Next
                    Else
                        w = .Item(txt)
                        a(w(0), 3) = a(w(0), 3) + a(i, 3)
                        .Item(txt) = w
                    End If
                End If
            Next
            n = .Count + 1
        End With
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets("Recap").Delete
        On Error GoTo 0
        Sheets.Add(before:=Sheets(1)).Name = "Recap"
        With Sheets("Recap").Cells(1, 1).Resize(n, maxCol)
            .CurrentRegion.Clear
            .Value = a
            .Columns(1).Interior.ColorIndex = 19
            .Rows(1).Interior.ColorIndex = 43
            .VerticalAlignment = xlCenter
            .Columns(2).HorizontalAlignment = xlCenter
            .Font.Name = "Calibri"
            .Font.Size = 12
            .Borders.Weight = 2: .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
End Sub
klin89
 

Pièces jointes

  • Ingel.xls
    91.5 KB · Affichages: 48
Vote positif 0 Vote négatif
klin89

klin89

XLDnaute Accro
Re : Remplir une recap a partir des onglets d'un classeur

Bonsoir le forum,

Plus clair :
VB: 
Sub Synthese1()
Dim a, i As Long, j As Long, n As Long, txt As String
    Application.ScreenUpdating = False
    With Sheets("rapport").Range("A1").CurrentRegion
        a = .Value
        n = 1
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If a(i, 2) = 1 Then
                    txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
                    If Not .exists(txt) Then
                        n = n + 1
                        For j = 1 To UBound(a, 2)
                            a(n, j) = a(i, j)
                        Next
                        .Item(txt) = n
                    Else
                        a(.Item(txt), 3) = a(.Item(txt), 3) + a(i, 3)
                    End If
                End If
            Next
        End With
    End With
    'Résultat dans une autre feuille
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Recap").Delete
    On Error GoTo 0
    Sheets.Add(before:=Sheets(1)).Name = "Recap"
    With Sheets("Recap").Cells(1).Resize(n, UBound(a, 2))
        .CurrentRegion.Clear
        .Value = a
        .Columns(1).Interior.ColorIndex = 19
        .Rows(1).Interior.ColorIndex = 43
        .Columns(2).HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Name = "Calibri"
        .Font.Size = 12
        .Borders.Weight = 2: .Columns.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub
klin89
 
Dernière édition:
Vote positif 0 Vote négatif
I

ingel

XLDnaute Nouveau
Re : Remplir une recap a partir des onglets d'un classeur

Merci c'est bien gentil de votre part.
par contre d'apres ce que j'ai compris, votre script s'exécute sur la feuille Rapport alors que moi je veut que la feuille recap se rempli en parcourant tous les onglets pays.
est ce que cela est possible ?
Merci
cdt.
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

H
  • Question
Microsoft 365 Automatiser la conversion des montants en fonction des devises
Réponses
6
Affichages
338
sylvanu
sylvanu
Q
  • Question
Microsoft 365 Créer un formulaire pour duplication d'onglet avec tableau
Réponses
6
Affichages
188
job75
job75
S
  • Question
XL 2016 saisie automatique des données dans une feuille recap à partir des autres feuilles
Réponses
4
Affichages
546
sylvanu
sylvanu
C
  • Résolu(e)
Microsoft 365 SommeSi VBA avec integration de variable
Réponses
5
Affichages
291
danielco
D
Yuby
  • Résolu(e)
XL 2013 Nommez tous les onglets d'un classeur par rapport à une même cellule dans chaque onglet
Réponses
5
Affichages
399
mapomme
mapomme
Simbaa
  • Question
Microsoft 365 Création d'un fichier entier par rapport à des entrées via UserForm
Réponses
1
Affichages
341
job75
job75
P
  • Question
XL 2013 Copier une formule dans un cellule depuis une cellule d'un onglet nouvellement crée en macro VBA
Réponses
8
Affichages
470
pascalou1
P
K
  • Question
Microsoft 365 Création d'un journal d'écriture à partir d'un tableau des ventes
2
Réponses
15
Affichages
2 K
CARTER92
C
B
  • Question
XL 2016 Comment figer une formule dans une nouvelle ligne insérée.
Réponses
1
Affichages
251
Lolote83
L
A
  • Résolu(e)
XL 2010 Copier / Coller un bouton de commande (activex) avec son code dans plusieurs feuilles
Réponses
2
Affichages
520
Alappero
A

Membres actuellement en ligne

25 membres et 386 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 100
Messages
2 085 292
Membres
102 852
dernier inscrit
Badrcola26