VB Copier/Coller onglet dans nouveaux classeurs avec boucle

DBiche

XLDnaute Nouveau
Bonjour à tous,

Je suis un peu novice en matière de macro c'est pourquoi j'ai besoin de votre aide.

Voila ce que je veux que ma macro fasse :
Il y a, dans un premier onglet, un tableau qui récapitule pour le nom de chacun des onglets de mon classeur (59 onglets pour le moment mais il pourra y en avoir plus)
Je veux que ma macro se réfère à se tableau pour copier chacun des onglets suivants (de façon indépendante) pour qu'ils deviennent chacun un fichier différent. En gros, je veux que mes 59 onglets deviennent 59 classeurs et qu'ils s'enregistrent grace à un chemin pré-définit dans mon tableau.
J'ai utilisé la boucle Do While avec un compteur mais la macro ne me copie et enregistre que la premier onglet sur les 59 et je ne comprends pas pourquoi... :/

Sub Macro_ventil_onglet_ETPDAC2()

Dim Var_Nom_Classeur As String
Dim Var_Destination_Fichiers As String
Dim Var_Période As String
Dim Var_Onglet As String
Dim Var_CB As Integer

Var_CB = 15
Var_Destination_Fichiers = Cells(7, 1).Value
Var_Onglet = Cells(Var_CB, 1).Value
Libellé_Fichier = Cells(Var_CB, 4).Value
Var_Nom_Classeur = Cells(4, 1).Value

Worksheets("Macro").Activate


Do While Cells(Var_CB, 1).Value <> ""
Sheets(Var_Onglet).Select
Sheets(Var_Onglet).Copy
ActiveWorkbook.SaveAs Filename:= _
Libellé_Fichier, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Var_CB = Var_CB + 1
Loop


End Sub


Merci par avance de votre aide.
 

Efgé

XLDnaute Barbatruc
Re : VB Copier/Coller onglet dans nouveaux classeurs avec boucle

Bonjour DBiche,
Il aurait été préférable de fournir un exemple. Avec ce que j'ai compris et imaginé, je fais une proposition:
VB:
Sub Test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Plg = Sheets("Macro").Range(Cells(15, 1), Cells(15, 1).End(xlDown))
For Each C In Plg
ThisWorkbook.Sheets(C.Value).Copy
ActiveWorkbook.SaveAs Filename:=C.Offset(0, 3).Value & "/" & C.Value
ActiveWorkbook.Close
Next C
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Copies terminées"
End Sub
A modifier suivant l'emplacement des données. Voir exemple
Cordialement
 

Pièces jointes

  • DBiche.xls
    33.5 KB · Affichages: 87

Statistiques des forums

Discussions
311 720
Messages
2 081 924
Membres
101 841
dernier inscrit
ferid87