Petits soucis VBA concernant "Worksheet"

**mateoa44** · 18/04/2016, 14h34

Bonjour,

Je viens sur ce forum ayant des petits soucis sur mon code VBA.

Je vous explique brièvement le problème.

J'ai un fichier source contenant 3 feuilles (on va dire A, B et C). Chaque feuille contient l'identifiant d'un groupe (16 groupes) et d'autres colonnes qui diffèrent selon la feuille A B ou C.

J'ai tout d'abord créé un code VBA permettant de transformer ces 3 feuilles en 48 feuilles (une feuille par groupe et par feuille (16 feuilles pour A, 16 pour B et 16 pour C)

Voici le code utilisé :

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
Private Sub CommandButton1_Click()
Dim i As Integer
Dim j As Integer
Dim maxfeuil As Integer, m As Integer
maxfeuil = Sheets.Count
For m = 1 To maxfeuil
 Sheets(m).Activate
        For i = 1 To 9
            Range("B1").Activate
            Selection.AutoFilter
            ActiveSheet.Range("$A$1:$O$428").AutoFilter Field:=2, Criteria1:="10" & i
            Range("A1:AD428").Select
 
            Selection.Copy
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Paste
            Sheets(m).Select
            Application.CutCopyMode = False
            Selection.AutoFilter
        Next
            For j = 10 To 16
                Range("B1").Activate
                Selection.AutoFilter
                ActiveSheet.Range("$A$1:$O$428").AutoFilter Field:=2, Criteria1:="1" & j
                Range("A1:AD428").Select
 
                Selection.Copy
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Paste
                Sheets(m).Select
                Application.CutCopyMode = False
                Selection.AutoFilter
            Next
 Next
End Sub

Ensuite j'aimerais coller les feuilles pour chaque groupe dans un nouveau classeur (il y a 3 feuilles pour un groupe)
Ainsi je dois obtenir à la fin 16 classeurs avec 3 feuilles (A, B et C) pour chaque groupe. (Exemple : un premier classeur avec 3 feuilles, A B et C avec les info du groupe 1, un deuxième classeur avec 3 feuilles, A B et C avec les infos du groupe 2, et ainsi de suite jusqu'au groupe 16).

Le problème est que je dois copier coller les feuilles correspondante. Donc après mon premier code, j'ai 48 feuilles, je dois donc pour le premier classeur copier coller les feuilles 4, 20 et 36, pour le deuxième classeur les feuilles 5,21 et 37, pour le 3e, les feuilles 6, 22 et 38 et ainsi de suite.

Voici mon ébauche de code, je reste coincé..

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
Private Sub CommandButton3_Click()
Dim i As Integer
Dim Cible As Workbook
Dim Ws As Worksheet
 
Application.DefaultSaveFormat = xlOpenXMLWorkbook
 For i = 1 To 16 'Création des 16 classeurs
Set Cible = Application.Workbooks.Add
 
For Each Ws In ThisWorkbook.Worksheets 'dans cette étape que ça coince
    Ws.Copy before:=Cible.Worksheets("Feuil1")
Next Ws
Next i
 
 
Application.DefaultSaveFormat = xlExcel8
End Sub

Merci par avance !!!!

Invité · 18/04/2016, 15h07

Bonjour,

A votre place, j'aurais dupliqué les 3 onglets dans un fichier modèle (template) du type xltx ou xltm que j'aurais dupliqué 16 fois.

Cordialement.

**parmi** · 18/04/2016, 15h32

Bonjour,

Je pense que quelque chose comme ceci devrait fonctionner

Code :

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

1
2
3
4
5
6
7
8
9
Sub CreerFichiers()
    Dim I As Integer
 
    For I = 1 To 16
        Sheets(Array(I + 3, I + 19, I + 35)).Copy
        ActiveWorkbook.SaveAs "Le nom du fichier"  'reste à trouver un nom...
        ActiveWorkbook.Close False
    Next
End Sub

**mateoa44** · 18/04/2016, 15h56

Bonjour Parmi,

Merci pour ta réponse, c'est ce que je veux faire oui ! Et plus simple de ce que je m'attendais...

Quelques questions tout de même :

J'aimerai ajouté en nom du fichier par exemple "Groupe 101" puis "Groupe 102" .... "Groupe 116"

J'ai modifié ton code de cette façon (j'ai fais exprès de mettre 4 pour éviter que ça tourne trop longtemps inutilement, quand ça sera bon, je remplacerai 4 par 16) :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub CommandButton4_Click()
    Dim I As Integer
    Dim J as Integer
    For J = 1 to 4
    For I = 1 To 4
 
        Sheets(Array(I + 3, I + 19, I + 35)).Copy
        ActiveWorkbook.SaveAs "Le nom du fichier" & J                       'reste à trouver un nom...
        ActiveWorkbook.Close False
    Next
    Next
End Sub

Cependant ça ne marche pas ! j'ai le message "Le fichier existe déjà, voulez vous le remplacer ?"

Autres questions :

-> j'aimerai que les trois feuilles à copier aient un nom particulier :

Première feuille : "Téléphonie"
Deuxième "Réclamations et demandes"
Troisième "Relation client"

Comment faire ?

-> Comment faire pour que les classeurs s'enregistrent sur ma clé en E: ?

Merci encore !

D'ailleurs, les fichiers qui s'enregistrent sont tous les mêmes, il ne prend pas en compte la boucle, j'ai 4 fichiers identiques autrement dit avec les info du premier groupe à chaque fois.

Edit : Si je ne déclare pas une variable J mais que je fais "Nom du fichier" & I cela fonctionne.

Je recherche toujours comment renommer les trois feuilles créés automatiquement et l'emplacement de sauvegarde

**parmi** · 18/04/2016, 16h15

Tu n'as besoin que d'une seule boucle, puisque tu copies les 3 onglets d'un coup.

Et comme ça, qu'est-ce que ça dit ?

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub CreerFichiers()
    Dim I As Integer
 
    For I = 1 To 16
        Sheets(Array(I + 3, I + 19, I + 35)).Copy
        ActiveWorkbook.SaveAs "Groupe 1" & format(I,"00")  'reste à trouver un nom...
        ActiveWorkbook.Sheets(1).name="Téléphonie"
        ActiveWorkbook.Sheets(2).name="Réclamations et demandes"
        ActiveWorkbook.Sheets(3).name="Relation client"
        ActiveWorkbook.Close False
    Next
End Sub

**mateoa44** · 18/04/2016, 16h30

Merci pour ta réponse :

SEULE la première feuille du PREMIER fichier est renommée en téléphonie !!! :/

**parmi** · 18/04/2016, 16h34

Oups... désolé, mais j'avais écrit à main levée.
La sauvegarde doit se faire à la fin...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub CreerFichiers()
    Dim I As Integer
 
    For I = 1 To 16
        Sheets(Array(I + 3, I + 19, I + 35)).Copy
        ActiveWorkbook.Sheets(1).name="Téléphonie"
        ActiveWorkbook.Sheets(2).name="Réclamations et demandes"
        ActiveWorkbook.Sheets(3).name="Relation client"
        ActiveWorkbook.SaveAs "Groupe 1" & format(I,"00")  'reste à trouver un nom...
        ActiveWorkbook.Close False
    Next
End Sub

**mateoa44** · 18/04/2016, 17h02

Ok bah c'est génial, merci énormément pour le temps que tu m'as consacré !!!!

J'aurais tout de même une dernière question si ça ne te dérange pas ..

C'est parfait, ça prend le bon nom, les onglets se renomment bien comme il faut, et ça s'enregistre sans problème.

Ca s'est enregistré sur ma clé USB, cependant j'aimerais en connaître la raison ? C'est parce que le fichier sur lequel je travail est sur ma clé aussi ?

**parmi** · 18/04/2016, 17h14

J'imagine, oui.
Si tu veux les placer dans un répertoire que tu connais, ajoute le chemin devant le nom
Et j'ai ajouté l'extension au cas où...

Code :

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

ActiveWorkbook.SaveAs "C:\Repertoire\Autre repertoire\Groupe 1" & format(I,"00")" & .xlsx

**mateoa44** · 18/04/2016, 17h17

Et bien MERCI beaucoup beaucoup beaucoup, je t'en suis très reconnaissant pour toute cette aide et ce temps que tu m'as consacré !!!!!!

Petits soucis VBA concernant "Worksheet"

Macros et VBA Excel

Discussions similaires

Partager

Partager