Discussion :

[P4nd0r3]

Bonjour,
Voici mon draft de code avec lequel je souhaiterais copier, à partir d'un classeur source, une feuille+la dernière feuille dans un nouveau classeur cible qui sera situé dans le même répertoire que la source et dont le nom sera la concaténation du nom du fichier source initial et du nom de la 1ère feuille copiée. Le tout devant boucler afin d'obtenir autant de nouveaux fichiers que d'onglets (-1 puisque à chaque fois c'est la feuille active et la dernière feuille du fichier source qui doivent être copiées).

Pour info, les différentes feuilles du fichier source ont été créées à partir d'un tableau croisé dynamique (via un filtre automatique générant un onglet par entrée du filtre). J'ai aussi désactivé les fonctions 'drill-down' et filtre du tableau croisé à l'aide d'un autre code que je souhaiterais à terme également inclure dans la boucle ci-dessous pour que tout soit fait automatiquement.

A ce stade, l'éditeur VBA m'indique qu'il ne trouve pas mon 'if', je pense que ça doit venir du fait que je n'ai pas indiqué d'argument après le 'else' puis que je veux qu'il continue à dérouler le code. J'avoue qu'étant débutante en VBA, je bloque un peu là...

Donc un grand merci d'avance pour vos conseils.
Pandy

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
 
'copier des onglets dans un nouveau classeur qui sera situé dans le même répertoire que le classeur source_
'et le nom du nouveau classeur est celui du classeur initial + le nom de la 1ère feuille copiée
 
Sub Copyinnewwkb_test()
Dim Wkbsource As Workbook
Dim Newwkb As Workbook
Dim Newwkbname As String
Dim Tabs As Integer
 
Set Wkbsource = ActiveWorkbook
Set Newwkb = Workbooks.Add
 
For Tabs = 1 To Wkbsource.Sheets.Count
 
    Wkbsource.Sheets(Array(Tabs, Wkbsource.Sheets.Count)).Copy Before:=Newwkb.Sheets(1)
 
    Newwkbname = Wkbsource.Path & Wkbsource.Name & " - " & Newwkb.Sheets(1).Name & ".xlsx"
 
    Newwkb.SaveAs Newwkbname
 
    Newwkb.Save
    Newwkb.Close
 
    Set Newwkb = Nothing
 
    If MsgBox("Le classeur", Newwkbname, "a été créé.", "Voulez vous continuer", vbQuestion + vbYesNo) = vbNo Then Exit Sub
 
    Else
 
Next Tabs
 
End If
 
End Sub

[Philippe Tulliez]

Bonjour,
Pour copier une ou plusieurs feuilles d'un classeur vers un nouveau classeur il ne faut pas le créer avant d'effectuer la copie.
Exemple

Code :

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

1
2
3
4
5
6
7
Sub CopySheets2NewWorkbook()
 Dim wkbSource As Workbook
 Set wkbSource = ThisWorkbook
 With wkbSource
 .Sheets(Array("Backup", .Sheets.Count)).Copy
 End With
End Sub

Pour cet exemple, on peut bien entendu se passer de la variable objet wkbSource

Code :

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

1
2
3
4
5
Sub CopySheets2NewWorkbook()
 With ThisWorkbook
 .Sheets(Array("Backup", .Sheets.Count)).Copy
 End With
End Sub

[P4nd0r3]

Ok Merci. Je viens de corriger mais l'éditeur me dit qu'il manque toujours le if. et je ne comprends pas pourquoi.
ci-dessous le nouveau code modifié (j'ai également ajouté le fait qu'il faut que la macro boucle que jusqu'à la feuille n-1:

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
Sub Copyinnewwkb_test()
Dim Wkbsource As Workbook
Dim Newwkb As Workbook
Dim Newwkbname As String
Dim Tabs As Integer
 
Set Wkbsource = ThisWorkbook
 
For Tabs = 1 To (Wkbsource.Sheets.Count - 1)
    With Wkbsource
        .Sheets(Array(Tabs, Wkbsource.Sheets.Count)).Copy
    End With
 
    Set Newwkb = Workbooks.Add
 
    Newwkbname = Wkbsource.Path & Wkbsource.Name & " - " & Newwkb.Sheets(1).Name & ".xlsx"
 
    Newwkb.SaveAs Newwkbname
 
    Newwkb.Save
    Newwkb.Close
 
    Set Newwkb = Nothing
 
    If MsgBox("Le classeur", Newwkbname, "a été créé.", "Voulez vous continuer", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    Else
 
Next Tabs
End If
End Sub

[Philippe Tulliez]

Bonjour,
Je vois deux erreurs.
D'une part, l'instruction Exit Sub doit être à la ligne qui suit le Then et de plus le End If est après le Next
Soit

Code :

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

1
2
3
4
  If MsgBox("Le classeur", Newwkbname, "a été créé.", "Voulez vous continuer", vbQuestion + vbYesNo) = vbNo Then
    Exit Sub
   Else
  End If

Cependant, comme il n'y a pas d'instruction si la condition est fausse, il est préférable d'écrire la ligne d'instruction comme ci-dessous. Soit sans Else et sans le End If

Code :

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

If MsgBox("Le classeur", Newwkbname, "a été créé.", "Voulez vous continuer", vbQuestion + vbYesNo) = vbNo Then Exit Sub

[P4nd0r3]

Merci!! cette fois le code s'exécute correctement.

Par contre,

• la macro copie bien la première et la dernière feuille dans un nouveau classeur qu'elle nomme 'book 1.xlsx' mais n'enregistre pas ce fichier qui reste ouvert, du coup la boucle s'arrête... et j'ai une boite d'erreur qui me dit "the file 'monnomdefichier - sheet 1.xlsx' already exists in this location. do you want to replace it?" alors qu'il n'y a aucun fichier portant ce nom dans le répertoire "actif".
  Mais au lieu de ça, je me rends compte que la macro a créé un classeur vide portant ce nom 'monnomdefichier - Sheet 1.xlsx' dans le répertoire de niveau supérieur.
  En précisant que le 'Sheet 1' était tel quel, c'est à dire que la macro ne reprennait pas le nom de la 1ère feuille source copiée pour compléter le nom du nouveau fichier mais j'ai corrigé ce point en ajoutant la variable 'Tabs' ici ->

  Code :

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

  Newwkb.Sheets(Tabs).Name

Je me demande donc :

• Comment faire pour que la macro enregistre le bon fichier (celui où elle a copié les feuilles) avec le bon nom puisque pour l'instant elle crée 2 nouveaux classeurs distincts mais celui comptenant les données copiées n'est pas celui qui est enregistré?...
  Et si ça n'aiderait pas un peu si je lui précise le répertoire où la macro doit enregistrer le nouveau fichier puisqu'elle a l'air de ne pas prendre le bon répertoire comme cible?

Voici le code modifié:

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
 
Sub Copyinnewwkb_test()
Dim Wkbsource As Workbook
Dim Newwkb As Workbook
Dim Newwkbname As String
Dim Tabs As Integer
 
Set Wkbsource = ThisWorkbook
 
For Tabs = 1 To (Wkbsource.Sheets.Count - 1)
    With Wkbsource
        .Sheets(Array(Tabs, Wkbsource.Sheets.Count)).Copy
    End With
 
    Set Newwkb = Workbooks.Add
        With Newwkb
        .SaveAs Filename:=Wkbsource.Name & " - " & Wkbsource.Sheets(Tabs).Name & ".xlsx"
        .Save
        .Close
        End With
 
    Set Newwkb = Nothing
    If MsgBox("Le classeur", Newwkbname, "a été créé.", "Voulez vous continuer", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Next Tabs
End Sub

Merci pour vos suggestions et conseils
Pandy

[Philippe Tulliez]

Bonjour,

j'ai une boite d'erreur qui me dit "the file 'monnomdefichier - sheet 1.xlsx' already exists in this location. do you want to replace it?" alors qu'il n'y a aucun fichier portant ce nom dans le répertoire "actif".

Il est évident que si tu reçois ce type de message, le fichier est bien présent. Il est vraisemblablement dans le répertorie par défaut prévu dans Office et il suffit de faire une recherche avec l'explorateur Windows pour le retrouver.

Et si ça n'aiderait pas un peu si je lui précise le répertoire où la macro doit enregistrer le nouveau fichier puisqu'elle a l'air de ne pas prendre le bon répertoire comme cible?

C'est très certainement la meilleure façon de procéder.
Si tu souhaites sauver le classeur dans le répertoire du classeur où est écrit la procédure VBA, c'est ThisWorkbook.Path sinon pour obtenir le nom du répertoire d'un autre classeur, c'est Workbooks("NomDuClasseur.xlsx").Path