copie mutiple de feuilles

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
alfazoulou

alfazoulou

XLDnaute Occasionnel
Re bonjour à tous.
ma question concerne la copie multiple de feuilles comme indiqué dans le titre.🙂

Je sais écrire un code qui copie l'onglet feuill1, le place après l'onglet feuill10 et le nomme facture 1.
Comme ci dessous.

Sheets("feuill1").Copy After:=Sheets("feuill10")
Sheets("feuill1 (2)").Activate
Sheets("feuill1 (2)").Name = "facture 1"

Ma question:
comment faire pour copier l'onglet feuill1 en 10 exemplaires, les placer après l'onglet feuill10 et les nommer facture 1, facture 2, facture 3, etc...

Merci pour votre aide.
 
Trier par date Trier par votes
Re : copie mutiple de feuilles

Bonsoir,

Sur Excel 2002, je ne reproduis pas le phenomene que tu decris ...
A savoir, lancer la macro, supprimer les 10 feuilles, relancer la macro, supprimer les 10 feuilles etc ...
Ca ne plante jamais chez moi ...

Il faudrait que qqun teste en XL 2003
 
Vote positif 0 Vote négatif
Re : copie mutiple de feuilles

Excusez moi, ce matin tout semble fonctionner correctement.
Sans doute un problème avec mon ordi.😕

Sinon j'ai une autre question qui me turlupine:
pour copier une feuille en dernier, doit on obligatoirement préciser le nom de la dernière feuille?
par exemple dans l'éditeur de macro en choisissant de copier la feuil1 en dernier on obtient:

Sheets("Feuil1").Select
Sheets("Feuil1").Copy After:=Sheets(3)
Comment faire si on ne connais pas le nom de la dernière feuille ???

Merci à tous pour vos réponses.
 
Vote positif 0 Vote négatif
Re : copie mutiple de feuilles

Tout d'abord excusez moi de ne pas mettre mon fichier en pièce jointe mais il fais 1,9MO contre 50KO pour le fichier d'origine; Je ne comprends pas pourquoi.

Mon soucis:
j'ai mis en pratique les infos que vous m'avez donné mais j'ai encore un problème.

En effet le but de cette macro étant de:
1/ copier la feuille Sheets("DEVIS DE A à Z"), la placer en dernier, et la renommer Sheets("Devis 1").
2/copier la feuille Sheets("DEVIS DE A à Z 2"), en reproduire 9 exemplaires et les nommer
Sheets("Devis 2"),Sheets("Devis 3") etc...
3/appliquer le même formatage à certains groupes de cellules de toute les feuilles Devis 1, Devis 2, Devis 3, etc...
4/copier dans certaines cellules de toutes ces feuilles "devis" des données contenues dans une autre feuille.
Le problème c'est que les données ne sont copiées sur toutes les feuilles que jusqu'à la ligne en gras, je ne comprends pas pourquoi d'autant plus que ce code est adapté de celui que vous m'avez fournis qui est plus simple car une seule instruction mais qui fonctionne.

Mon code:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Sheets("DEVIS DE A à Z").Copy After:=Sheets(Sheets.Count)
Sheets("DEVIS DE A à Z (2)").Activate
Sheets("DEVIS DE A à Z (2)").Name = "Devis 1"

Sheets("DEVIS DE A à Z 2").Copy After:=Sheets("Devis 1")

For i = 2 To 9

ActiveSheet.Name = "Devis " & i
Sheets("DEVIS DE A à Z 2").Copy After:=Sheets("devis " & i)
Next
ActiveSheet.Name = "Devis " & i

Dim MesFeuilles(9)
For i = 0 To 9
MesFeuilles(i) = "Devis " & i + 1
Next
Sheets(MesFeuilles).Select

Sheets("Devis 1").Range("B58:B62").Select

With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
.Font.Bold = False
.Value = [condition_retenue]
End With


Sheets("Devis 1").Range("B57").Value = "Conditions de paiement:"
Selection.Font.Bold = True

Sheets("Devis 1").Range("B63").Value = "Validité du devis:" & " " & [validité_retenue]

Sheets("Devis 1").Range("D58:G62").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = False

End With
Selection.Merge

Sheets("Devis 1").Range("D58").Value = [bon_pour_accord_retenu]


Sheets("Devis 1").Range("G54").Formula = "=SUM(G23:G53)"
Sheets("Devis 1").Range("G55").Formula = "=(G54*tva_retenue%)"
Sheets("Devis 1").Range("G56").Formula = "=(G54+G55)"
Sheets("Devis 1").Range("G54:G56").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
.NumberFormat = "0.00"
End With

Sheets("Devis 1").Range("E54") = "Total HT"
Sheets("Devis 1").Range("E55") = "TVA" & " " & [tva_retenue] & " " & "%"
Sheets("Devis 1").Range("E56") = "Total TTC"

Sheets("Devis 1").Range("E54:E56").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
End With


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

le code que vous m'avez fournis:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Feuil1").Copy After:=Sheets("Feuil3")
For i = 1 To 9
ActiveSheet.Name = "Devis " & i
Sheets("Feuil2").Copy After:=Sheets("devis " & i)
Next
ActiveSheet.Name = "Devis " & i
Dim MesFeuilles(9)
For i = 0 To 9
MesFeuilles(i) = "Devis " & i + 1
Next
Sheets(MesFeuilles).Select
Sheets("Devis 1").Range("A58:A62").Select
With Selection
.Font.Bold = True
.Interior.ColorIndex = 6
.Interior.Pattern = xlSolid
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Merci d'avance de votre aide;
je m'arrache mes cheveux, j'en suis à mon 3eme doliprane...🙁
en espérant que vous pourrez m'aider je vous souhaite une bonne après midi à toutes et tous.
 
Vote positif 0 Vote négatif
Re : copie mutiple de feuilles

Catrice à dit:
Re,

A quoi correspondent :
[condition_retenue]
[bon_pour_accord_retenu]
etc ...
Cliquez pour agrandir...

ce sont des cellules d'une autre feuille, que j'ai nommé ainsi et qui contiennent les valeurs à copier dans chacune des feuilles.
S'agissant de la création d'un programme de devis facturation, la cellule nommée condition retenue peut contenir des textes du style "paiement à la livraison", bien sur ces textes peuvent changer selon les désirs de l'utilisateur.
Merci de t'intéresser à mon problème.
En fait j'ai réussi à détourner en faisant un code qui me parait très lourd et que je voudrais simplifier, voici ci dessous l'extrait qui nous intéresse:

Sheets("DEVIS DE A à Z").Copy After:=Sheets(Sheets.Count)
Sheets("DEVIS DE A à Z (2)").Activate
Sheets("DEVIS DE A à Z (2)").Name = "Devis 1"

'---------------------------------
Sheets("Devis 1").Select
Sheets("Devis 1").Range("B58:B62").Select

With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
.Font.Bold = False
End With

Range("B58:B62").Value = [condition_retenue]

If [condition_retenue].Value <> "" Then
Range("B57").Value = "Conditions de paiement:"
Selection.Font.Bold = True
Else
Range("B57").Value = ""
End If
If [validité_retenue].Value <> "" Then
Range("B63").Value = "Validité du devis:" & " " & [validité_retenue]

End If

If [bon_pour_accord_retenu].Value <> "" Then
Range("D58:G62").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = False

End With
Selection.Merge
Range("D58").Value = [bon_pour_accord_retenu]


Else
Range("D58:G62").ClearContents
End If
'--------------------------

Range("G54").Formula = "=SUM(G23:G53)"
Range("G55").Formula = "=(G54*tva_retenue%)"
Range("G56").Formula = "=(G54+G55)"
Range("G54:G56").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
.NumberFormat = "0.00"
End With

Range("E54") = "Total HT"
Range("E55") = [taux_tva]
Range("E56") = "Total TTC"

Range("E54:E56").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
End With



'-------------------------------

Sheets("DEVIS DE A à Z 2").Copy After:=Sheets("Devis 1")
Sheets("DEVIS DE A à Z 2 (2)").Activate
Sheets("DEVIS DE A à Z 2 (2)").Name = "Devis 2"
Sheets("Devis 2").Range("B58:B62").Select

With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
.Font.Bold = False
End With
'Range("inser").Select
Range("B58:B62").Value = [condition_retenue]



If [condition_retenue].Value <> "" Then
Range("B57").Value = "Conditions de paiement:"
Selection.Font.Bold = True
Else
Range("B57").Value = ""
End If
If [validité_retenue].Value <> "" Then
Range("B63").Value = "Validité du devis:" & " " & [validité_retenue]

End If

If [bon_pour_accord_retenu].Value <> "" Then
Range("D58:G62").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = False

End With
Selection.Merge
Range("D58").Value = [bon_pour_accord_retenu]



Else
Range("D58:G62").ClearContents
End If
'--------------------------

Range("G54").Formula = "=SUM(G10:G53)"
Range("G55").Formula = "=(G54*tva_retenue%)"
Range("G56").Formula = "=(G54+G55)"
Range("G54:G56").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
.NumberFormat = "0.00"
End With

Range("E54") = "Total HT"
Range("E55") = [taux_tva]
Range("E56") = "Total TTC"

Range("E54:E56").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
End With



For i = 2 To 9

ActiveSheet.Name = "Devis " & i
Sheets("Devis 2").Copy After:=Sheets("devis " & i)
Next
ActiveSheet.Name = "Devis " & i

' Dim MesFeuilles(9)
'For i = 2 To 9
'MesFeuilles(i) = "Devis " & i + 1
'Next

Sheets("Devis 1").Activate
Sheets("Devis 1").Range("B15").Value = "Réf. Devis:" & " " & [nom_devis]
' Call conditions_page_2
Range("inser").Select
End If
 
Vote positif 0 Vote négatif
Re : copie mutiple de feuilles

Décidément les quelques cheveux qui me restent vont disparaitre en fumée.
depuis hier je vous sollicite pour divers problèmes sur ce fil et à un moment donné j'ai évoqué la possibilité d'un bug de mon ordi ou de mon tableur préféré.
Et bien cette hypothèse se confirme.
En effet j'ai mis en A30 la fonction=SOMME(A2:A28) et bien j'ai beau rentrer des valeurs dans cette zone rien ne se passe en A30.
voici le fichier joint, en espérant que vous pourrez m'aider.
j'ai l'impression d'abuser...
 

Pièces jointes

Vote positif 0 Vote négatif
Re : copie mutiple de feuilles

Application.Calculation = xlCalculationManual

Merci Pierrot93 tout s'explique sur ce dernier problème.
Le programme a du planter avant de remettre le calcul en auto.

Pour le reste de mes soucis ben ils sont pas résolus, voir un peu plus haut.
merci encore Pierrot93 tu m'a fait économiser quelques cachets d'aspirine.
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

C
  • Question Question
Microsoft 365 macro copie de feuilles (avec formules à adapter)
Réponses
9
Affichages
236
caseras
C
T
  • Question Question
XL 2013 Impression, choix de feuilles et nombre de copie
Réponses
11
Affichages
508
AtTheOne
AtTheOne
Usine à gaz
  • Résolu(e)
XL 2021 touches Ctrl+R pour revenir
Réponses
4
Affichages
542
TooFatBoy
TooFatBoy
B
  • Question Question
XL 2016 Interférence entre une boucle et un copie de feuille
Réponses
4
Affichages
575
Oneida
Oneida
jeff1494
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
559
jeff1494
jeff1494
M
  • Question Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
786
marie3107
M
A
  • Résolu(e)
XL 2010 Renomer copie de feuilles multiple
Réponses
5
Affichages
389
sylvanu
sylvanu
S
  • Résolu(e)
Microsoft 365 Envoi de la signature de l'utilisateur macro envoi de mail
Réponses
3
Affichages
447
spike29
S
A
  • Résolu(e)
XL 2016 Autofill Destination sur colonne adjacente
Réponses
3
Affichages
536
Aldonanou
A
E
  • Question Question
formulaire avec vba
Réponses
8
Affichages
880
vgendron
vgendron
R
  • Résolu(e)
Microsoft 365 Insérer une copie d'un onglet dans le classeur
Réponses
2
Affichages
610
Rosco1669
R
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
843
Nico2978
Nico2978
Z
  • Question Question
XL 2021 VBA Prélèvement d'une donnée si une valeur recherchée est identique
Réponses
3
Affichages
494
ZiM
Z
R
  • Résolu(e)
XL 2016 Fusionner 3 classeurs Excel en un seul.
Réponses
10
Affichages
1 K
ReneDav14000
R
13Hubert
  • Résolu(e)
Microsoft 365 VBA - Coller la valeur d'une cellule d'une autre feuille...
Réponses
11
Affichages
930
13Hubert
13Hubert
L
  • Résolu(e)
XL 2016 Lien hypertexte VBA
Réponses
1
Affichages
1 K
Louu59
L
M
  • Résolu(e)
XL 2013 Liens hypertexte / Nouvelle onglet
Réponses
8
Affichages
838
vgendron
vgendron
F
  • Question Question
Microsoft 365 copie de données colonne dans des nouveaux onglets
Réponses
5
Affichages
1 K
FCMLE44
F
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
M
  • Question Question
XL 2010 Insérer image dans une zone de texte
2
Réponses
15
Affichages
2 K
patricktoulon
patricktoulon
Retour