Discussion :

[laseck]

Bonjour à tous,

Je sollicite votre aide pour avoir des conseils pour réaliser un fichier.
Je cherche à créer des onglets dans mon classeur qui en fonction de leurs noms doivent venir compiler les onglets qui suivent.

Pour être plus clair, je souhaite que un onglet AGXXX viennent me compiler les onglets qui suivent jusqu'à la prochaine feuille AGXXX ...

J'ai réaliser le code suivant pour la création des onglets:

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub Creation_Onglets_P3M()
 
'''''''''''''''''''''''''
'''''Macro de Cédric '''''
'''''''''''''''''''''''''
 
 Dim ARBO As Range 'Définition de la plage de cellules
 
 Set ARBO = Sheets("INDEX").Range("C8:C" & Rows.Count).SpecialCells(xlCellTypeConstants)
 
 'La boucle suivante balaie toutes les cellules de la plage définie
 
 For Each Cel In ARBO
    Sheets("Maquette P3M").Select
    Cells.Copy
    Sheets.Add after:=Sheets(Worksheets.Count)
    ActiveSheet.Paste
 
 'Enfin, je récupère la ligne de la cellule en cours de lecture :
 
 
    ActiveSheet.Cells(4, 2) = Sheets("INDEX").Cells(Cel.Row, 3) 'Cells(4, 1) = A4
    ActiveSheet.Cells(3, 2) = Sheets("INDEX").Cells(Cel.Row, 7) 'nom de l'UO en B3 DE LA FEUILLE DUPLIQUER
 
 
    ActiveSheet.Name = Cells(4, 2) 'nom des feuilles
 
' Application des mises en forme à toutes les feuilles attention il faut que les feuilles soient toutes visibles
 
 
 
 
         Application.ScreenUpdating = False
               For i = 1 To Sheets.Count
                    Sheets(i).Visible = xlSheetVisible
                    Sheets(i).Activate
                    ActiveWindow.Zoom = 70 'zoom 70% sur toutes les feuilles
                    ActiveWindow.DisplayGridlines = False 'cadrillage 0
                Next i
            Application.ScreenUpdating = True
 
 'Créer une ligne de code pour appliquer la mise en forme ci dessus à toutes les feuilles sauf la première
 'créer une macro qui en fonction de DR; AG; SE compile les données (calcul)
 
 'créer une ligne de code pour mettre la mise en forme du ficli en affichage 70% et sans cadriage
 Next
 End Sub

Pouvez vous m'aider svp??

Merci

[MarcelG]

Bonjour et bienvenu au club,

En ce qui concerne ton code, pourquoi ne pas copier les feuille plutôt que les cellules
VoirMicrosoft worksheet copy

les onglets qui suivent

Mieux vaut à mon avis dresser une table
en A2 : nom de la feuille récipiendaire
de B2 à Bx : noms des feuilles qui vont être compilées dans la feuille nommée en A2
etc.. A3, A4...

[laseck]

Merci de votre réponse.

Mes onglets créé sont la duplication d'une feuille maquette. Les feuilles, via une formule SOMMEPROD viennent chercher dans une base de données les chiffres que je dois rapatrier.
je joins mon fichier en cours d'élaboration.
Maquette unique P3M 2015 VBA.xlsm

[MarcelG]

ALors qu'entends-tu par

je souhaite que un onglet AGXXX viennent me compiler les onglets qui suivent

?
Pourrais-tu donner un exemple précis sur une cellule, une formule...

[laseck]

Alors pour être plus clair .

J'ai une arborescence en feuille INDEX qui se présente de la façon suivante :

Une DR à plusieurs AG qui ont plusieurs SE.

Mon fichier vient créer des onglets en fonction de cette arbo et alimenter en fonction d'une BASE DE DONNEES les données dans les onglets.

J'aimerais c'est que lorsque un onglet AG est créé, il viennent me compiler les onglets SE. Le but serait de venir faire comme une somme de plusieurs onglets...

Est ce que c'est plus clair?

merci de votre patience je débute

[MarcelG]

Dans ce cas, j'opterais pour une portée plus globale de la fonction

Sommeprod

.

Si tu tiens à une formulation, et que tu ne connais pas à l'avance le nombre de feuilles nommées "SEXXX", alors tu peux utiliser la formulation R1C1 qui utilise la même adresse

Comme suit

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
Option Explicit
 
Sub ESSAISOM()
 
Dim wk As Worksheet
Dim laformule As String
Dim c As Range
 
laformule = "=0"
 
For Each wk In Worksheets
      With wk
            If Left(.Name, 5) = "SEXXX" Then laformule = laformule & "+SEXXX" & Right(.Name, 1) & "!RC"
      End With
Next wk
 
laformule = Replace(laformule, "0+", "")
 
For Each c In Worksheets("AGXXX3").Range("J25:J26")
      With c
            .FormulaR1C1 = laformule
            'collage spécial valeurs
            '.Value = .Value
      End With
Next c
 
End Sub

Verifie avant d'adapter le champ des cellules concernées.
Ensuite, tu pourras ôter le

'

pour effectuer un collage spécial valeurs.

[laseck]

ok je vois que la formule marche sur une seule cellule et ce qu'elle traduit


Ma sommeprod me permet de ramener les éléments de ma base de donnée ( réel ) de ma base de donnée. Je pense que je vais laisser en l'état la formule.
Parcontre je vais m'inspirer de ta solution afin de voir si je peux l'utiliser uniquement sur certaines feuilles.
Est ce que c'est compliqué d'expliquer dans le code que je veux, uniquement sur les feuilles commençant par AG, compiler les données des feuilles qui suivent jusqu'à la prochaine feuille AG?

Pour être plus clair:
une feuille AGxxx1 compile les données des feuilles SEXXX1-2-3
une feuille AGXXX2 compile les données des feuilles SEXXX4-5-6-7...
ainsi de suite ?

Merci en tout cas pour le coup de main

[MarcelG]

Salut,

Dans ce cas, soit tu utilises une table comme je l'ai mentionné dans mon 1er post, soit tu écris dans le code VBE comme suit.
La procédure est argumentée

AVANT D'ADAPTER, tu regarde ce code mot clé par mot clé et tu reviens si nécessaire.

A plus tard.

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Option Explicit
 
Option Base 1
 
Sub monessai()
Dim j As Byte
For j = 1 To 2
        Call ESSAISOM(j)
Next j
End Sub
 
Sub ESSAISOM(indexag As Byte)
 
Dim liste_se As Variant
 
Select Case indexag
        Case 1
                liste_se = Array(1, 2, 3)
        Case 2
                liste_se = Array(4, 5, 6, 7)
End Select
 
Dim i As Byte
Dim laformule As String
Dim c As Range
 
laformule = "=0"
 
For i = 1 To UBound(liste_se)
            laformule = laformule & "+SEXXX" & liste_se(i) & "!RC"
Next i
 
laformule = Replace(laformule, "0+", "")
 
For Each c In Worksheets("AGXXX" & indexag).Range("J25:J26")
      With c
            .FormulaR1C1 = laformule
            'collage spécial valeurs
            '.Value = .Value
      End With
Next c
 
End Sub

[laseck]

Ok je vais étudier cela
merci beaucoup en tout cas