Petits soucis VBA concernant "Worksheet"

Version imprimable

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:

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:

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 !!!!

18/04/2016, 15h07
Invité

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.

Bonjour,

Je pense que quelque chose comme ceci devrait fonctionner

Code:

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

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:

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

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:

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

18/04/2016, 16h30
mateoa44

Merci pour ta réponse :

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

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

Code:

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

18/04/2016, 17h02
mateoa44

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 ?
18/04/2016, 17h14
parmi

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:

ActiveWorkbook.SaveAs "C:\Repertoire\Autre repertoire\Groupe 1" & format(I,"00")" & .xlsx
18/04/2016, 17h17
mateoa44

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é !!!!!!