Ajout d'onglets selon critère

**Aurianelm** · 11/02/2014, 11h53

Bonjour tout le monde !

Voilà, j'ai plusieurs fichiers :
- Un fichier avec une liste d'agences et l'équipe à laquelle chacune est rattachée
- Un fichier Excel par agence avec les données qui m'intéressent
- Un fichier Maquette pour réaliser mes fichiers

Je dois réaliser un fichier par équipe en ouvrant à chaque fois le fichier de l'agence, en copier certains onglets, les coller dans le fichier maquette à la suite des onglets existants etc. Donc pour chaque fichier Equipe, il existe plusieurs agences, je dois donc à chaque ligne repérer l'équipe, regarder si c'est la même que la ligne du dessus, si oui ouvrir le fichier de l'agence, copier/coller les onglets et ainsi de suite.

Mon programme fonctionne à peu près correctement. Le seul hic est qu'il ne prend jamais en compte la dernière agence de l'équipe.

Exemple :
Agence 1 Equipe 1
Agence 2 Equipe 1
Agence 3 Equipe 1
Agence 4 Equipe 1
Agence 5 Equipe 2
Agence 6 Equipe 2

Dans le cas ci-dessus il me créé 2 fichiers, 1 pour l'équipe 1 avec les onglets des agences 1, 2 et 3 (mais pas la 4) et un autre pour l'équipe 2 avec les onglets de l'agence 5 (mais pas l'agence 6). Je comprends pourquoi ça ne fonctionne pas (il voit que Equipe 1 (au niveau de l'agence 4) ≠ Equipe 2 (au niveau de l'agence 5)) mais je n'arrive pas à voir comment faire autrement.

Voici le code que j'ai écrit :

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Sub soldes_nets_equipes()
 
Dim repertoire As String, fichierAgences As String, nomAgence As String, repMois As String
Dim codeAgence As String, codeEquipe As String, nomEquipe As String
Dim derLigneAgences As Integer, nbFeuilles As Integer
 
 
repertoire = "G:\"
fichierAgences = "Ptvt_ObjSldNet2014_V0.xls"
maquette = "maquette SN PART.xls"
 
Workbooks.Open Filename:=repertoire & fichierAgences
Workbooks.Open Filename:=repertoire & maquette
 
'Boîte de dialogue pour choisir le mois à traiter
UserForm1.Show
mois = UserForm1.ComboBox1.Value
If mois = "janvier" Then num_mois = 1
If mois = "février" Then num_mois = 2
If mois = "mars" Then num_mois = 3
If mois = "avril" Then num_mois = 4
If mois = "mai" Then num_mois = 5
If mois = "juin" Then num_mois = 6
If mois = "juillet" Then num_mois = 7
If mois = "août" Then num_mois = 8
If mois = "septembre" Then num_mois = 9
If mois = "octobre" Then num_mois = 10
If mois = "novembre" Then num_mois = 11
If mois = "décembre" Then num_mois = 12
 
annee = 2013
 
repMois = repertoire & "Livrables\" & annee & num_mois & "\"
NomFichier = "SUIVI SOLDE NET " & annee & num_mois & " - "
 
derLigneAgences = Workbooks(fichierAgences).Sheets(1).Range("A65000").End(xlUp).Row
 
For i = 2 To derLigneAgences
    j = 0
    Workbooks(fichierAgences).Activate
    Sheets(1).Range("E" & i).Select
    Do While ActiveCell = ActiveCell.Offset(1, 0)
        codeAgence = Workbooks(fichierAgences).Sheets(1).Cells(i, 1)
        nomAgence = Workbooks(fichierAgences).Sheets(1).Cells(i, 2)
        Workbooks.Open Filename:=repMois & NomFichier & codeAgence & " " & nomAgence
        ActiveCell = ActiveCell.Offset(1, 0)
        nomEquipe = Workbooks(fichierAgences).Sheets(1).Cells(i, 5)
        codeEquipe = Workbooks(fichierAgences).Sheets(1).Cells(i, 4)
        Workbooks(maquette).Sheets(1).Range("A36").Value = codeEquipe & " " & nomEquipe
        nbFeuilles = Workbooks(maquette).Worksheets.Count
        Workbooks(NomFichier & codeAgence & " " & nomAgence).Sheets(Array("SN TsMch", "RE TsMch", "SN MchPart", "RE MchPart")).Copy after:= _
        Workbooks(maquette).Sheets(nbFeuilles)
        NomFeuille1 = "SN TsMch " & codeAgence
        NomFeuille2 = "RE TsMch " & codeAgence
        NomFeuille3 = "SN MchPart " & codeAgence
        NomFeuille4 = "RE MchPart " & codeAgence
        Workbooks(maquette).Sheets("SN TsMch").Name = NomFeuille1
        Workbooks(maquette).Sheets("RE TsMch").Name = NomFeuille2
        Workbooks(maquette).Sheets("SN MchPart").Name = NomFeuille3
        Workbooks(maquette).Sheets("RE MchPart").Name = NomFeuille4
        i = i + 1
        Workbooks(NomFichier & codeAgence & " " & nomAgence).Close False
        Workbooks(fichierAgences).Activate
        Sheets(1).Range("E" & i).Select
    Loop
    Workbooks(maquette).SaveAs repMois & "RE PART\" & NomFichier & " " & codeEquipe & " " & nomEquipe
    Workbooks.Open Filename:=repertoire & maquette
    Workbooks(NomFichier & " " & codeEquipe & " " & nomEquipe).Close
Next i
End Sub

Merci par avance pour ce 1er problème.

J'ai un deuxième souci mais là je ne sais pas du tout comment faire. Dans chaque fichier Equipe, je dois faire des sommes en prenant des données dans les onglets précédemment ajoutés (copier/coller) mais comment insérer une formule sans connaître le nombre d'onglets ? (Car une équipe n'a pas forcément le même nombre d'agences).

Merci

Auriane

**Aurianelm** · 11/02/2014, 13h43

Finalement j'ai réussi la 1ère partie !

Pour ceux que ça intéresserait :

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Sub soldes_nets_equipes()
 
Dim repertoire As String, fichierAgences As String, nomAgence As String, repMois As String
Dim codeAgence As String, codeEquipe As String, nomEquipe As String
Dim derLigneAgences As Integer, nbFeuilles As Integer
 
 
repertoire = "G:\"
fichierAgences = "Ptvt_ObjSldNet2014_V0.xls"
maquette = "maquette SN PART.xls"
 
Workbooks.Open Filename:=repertoire & fichierAgences
Workbooks.Open Filename:=repertoire & maquette
 
'Boîte de dialogue pour choisir le mois à traiter
UserForm1.Show
mois = UserForm1.ComboBox1.Value
If mois = "janvier" Then num_mois = 1
If mois = "février" Then num_mois = 2
If mois = "mars" Then num_mois = 3
If mois = "avril" Then num_mois = 4
If mois = "mai" Then num_mois = 5
If mois = "juin" Then num_mois = 6
If mois = "juillet" Then num_mois = 7
If mois = "août" Then num_mois = 8
If mois = "septembre" Then num_mois = 9
If mois = "octobre" Then num_mois = 10
If mois = "novembre" Then num_mois = 11
If mois = "décembre" Then num_mois = 12
 
annee = 2013
 
repMois = repertoire & "Livrables\" & annee & num_mois & "\"
NomFichier = "SUIVI SOLDE NET " & annee & num_mois & " - "
 
derLigneAgences = Workbooks(fichierAgences).Sheets(1).Range("A65000").End(xlUp).Row
 
For i = 2 To derLigneAgences
    Workbooks(fichierAgences).Activate
    Sheets(1).Range("E" & i).Select
    If ActiveCell = ActiveCell.Offset(1, 0) Then
        codeAgence = Workbooks(fichierAgences).Sheets(1).Cells(i, 1)
        nomAgence = Workbooks(fichierAgences).Sheets(1).Cells(i, 2)
        Workbooks.Open Filename:=repMois & NomFichier & codeAgence & " " & nomAgence
        nomEquipe = Workbooks(fichierAgences).Sheets(1).Cells(i, 5)
        codeEquipe = Workbooks(fichierAgences).Sheets(1).Cells(i, 4)
        Workbooks(maquette).Sheets(1).Range("A36").Value = codeEquipe & " " & nomEquipe
        nbFeuilles = Workbooks(maquette).Worksheets.Count
        Workbooks(NomFichier & codeAgence & " " & nomAgence).Sheets(Array("SN TsMch", "RE TsMch", "SN MchPart", "RE MchPart")).Copy after:= _
        Workbooks(maquette).Sheets(nbFeuilles)
        NomFeuille1 = "SN TsMch " & codeAgence
        NomFeuille2 = "RE TsMch " & codeAgence
        NomFeuille3 = "SN MchPart " & codeAgence
        NomFeuille4 = "RE MchPart " & codeAgence
        Workbooks(maquette).Sheets("SN TsMch").Name = NomFeuille1
        Workbooks(maquette).Sheets("RE TsMch").Name = NomFeuille2
        Workbooks(maquette).Sheets("SN MchPart").Name = NomFeuille3
        Workbooks(maquette).Sheets("RE MchPart").Name = NomFeuille4
        Workbooks(NomFichier & codeAgence & " " & nomAgence).Close False
    Else
        If ActiveCell = ActiveCell.Offset(-1, 0) Then
            codeAgence = Workbooks(fichierAgences).Sheets(1).Cells(i, 1)
            nomAgence = Workbooks(fichierAgences).Sheets(1).Cells(i, 2)
            Workbooks.Open Filename:=repMois & NomFichier & codeAgence & " " & nomAgence
            nomEquipe = Workbooks(fichierAgences).Sheets(1).Cells(i, 5)
            codeEquipe = Workbooks(fichierAgences).Sheets(1).Cells(i, 4)
            Workbooks(maquette).Sheets(1).Range("A36").Value = codeEquipe & " " & nomEquipe
            nbFeuilles = Workbooks(maquette).Worksheets.Count
            Workbooks(NomFichier & codeAgence & " " & nomAgence).Sheets(Array("SN TsMch", "RE TsMch", "SN MchPart", "RE MchPart")).Copy after:= _
            Workbooks(maquette).Sheets(nbFeuilles)
            NomFeuille1 = "SN TsMch " & codeAgence
            NomFeuille2 = "RE TsMch " & codeAgence
            NomFeuille3 = "SN MchPart " & codeAgence
            NomFeuille4 = "RE MchPart " & codeAgence
            Workbooks(maquette).Sheets("SN TsMch").Name = NomFeuille1
            Workbooks(maquette).Sheets("RE TsMch").Name = NomFeuille2
            Workbooks(maquette).Sheets("SN MchPart").Name = NomFeuille3
            Workbooks(maquette).Sheets("RE MchPart").Name = NomFeuille4
            Workbooks(NomFichier & codeAgence & " " & nomAgence).Close False
            Workbooks(maquette).SaveAs repMois & "RE PART\" & NomFichier & " " & codeEquipe & " " & nomEquipe
            Workbooks.Open Filename:=repertoire & maquette
            Workbooks(NomFichier & " " & codeEquipe & " " & nomEquipe).Close
        End If
    End If
Next i
End Sub

Je mets ce sujet en RESOLU et en ouvrirais peut-être un autre pour mon second problème.

Merci pour ceux qui auront réfléchi à la résolution !

Ajout d'onglets selon critère [XL-2003]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager