Macro qui copie une feuille du classeur sur un autre classeur

Fermé

julien69960 Messages postés 2 Date d'inscription samedi 23 novembre 2013 Statut Membre Dernière intervention 29 novembre 2013 - 23 nov. 2013 à 11:41
Le Pingou Messages postés 12104 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 10 juin 2024 - 6 déc. 2013 à 22:48

Bonjour,
j'ai un petit soucis, je voudrais me creer une macro pour des etudes de prix,
chaqu'unes des etudes de prix peuvent contenir 8 parties différentes.
Dans mon classeur nouvelle etude de prix, j'ai crée 8 feuilles qui representent mes 8 parties.
a l'aide d'une userform nouvelle étude je demande quelles partient font parties de cette nouvelle étude.
je me retrouve avec par exemple une nouvelle étude qui a 4 parties.
je veux donc copier les 4 feuilles types du classeur nouvelle etude dans un nouveau classeur au nom de l'étude.
Si quelqu'un peux m'aider je cherche depuis trois jours et n'arrive pas.

A voir également:

Macro qui copie une feuille du classeur sur un autre classeur
Copie cachée - Guide
Impossible de modifier une macro dans un classeur masqué ✓ - Forum Excel
Étiquette classeur excel - Forum Logiciels
Macro word - Guide
Super copie - Télécharger - Gestion de fichiers

6 réponses

Réponse 1 / 6

Le Pingou Messages postés 12104 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 10 juin 2024 1 442
Modifié par Le Pingou le 23/11/2013 à 22:45

Bonjour,
Au passage essayer avec cette procédure:

Sub CopyFeuilleNouvCla()
'
' exemple sélectionne feuille 2 et 3 copie vers nouveau classeur et le nommé [NouvCla_2f]
Sheets(Array("Feuil2", "Feuil3")).Copy
' *** adapter le cheminselone votre répertoire
    ActiveWorkbook.SaveAs Filename:="C:\votre chemin\NouvCla_2f.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    
End Sub

Salutations.
Le Pingou

Réponse 2 / 6

julien69960 Messages postés 2 Date d'inscription samedi 23 novembre 2013 Statut Membre Dernière intervention 29 novembre 2013
29 nov. 2013 à 10:40

en fait j'ai mal posé mon problème.
regarde le script que j'ai créé:
Private Sub btn_type_Click()
Dim lignederniereetude As Integer
lignederniereetude = Worksheets("Liste Etude").Cells(3, 27)

If CheckBox1 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 13) = "X"
End If

If CheckBox2 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 14) = "X"
End If

If CheckBox3 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 15) = "X"
End If

If CheckBox4 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 16) = "X"
End If

If CheckBox5 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 17) = "X"
End If

If CheckBox6 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 18) = "X"
End If

If CheckBox7 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 19) = "X"
End If

If CheckBox8 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 20) = "X"
End If

If CheckBox9 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 21) = "X"
End If

If CheckBox10 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 22) = "X"
End If

If CheckBox11 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 23) = "X"
End If

If CheckBox12 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 24) = "X"
End If

If CheckBox13 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 25) = "X"
End If

If CheckBox14 = True Then
Worksheets("Liste Etude").Cells(lignederniereetude, 26) = "X"
End If

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim nombredonglet As Integer
Dim codeetude As String
Dim NomFichier As String
Dim i As Integer

nombredonglet = 3
i = 0

'On créer l'objet Excel
Set xlApp = CreateObject("Excel.Application")

'On défini le nombre d'onglets (ici 5)
Do
i = i + 1
If Worksheets("Liste Etude").Cells(lignederniereetude, 13 + i) = "X" Then
nombredonglet = nombredonglet + 1
End If
Loop Until i = 8

xlApp.SheetsInNewWorkbook = nombredonglet

'On ajoute un classeur
Set xlBook = xlApp.Workbooks.Add
'On donne un nom au classeur

codeetude = Worksheets("Liste Etude").Cells(lignederniereetude, 27)

'xlBook.SaveAs codeetude

NomFichier = codeetude & "_.xls"

xlBook.SaveAs (NomFichier)
'xlApp.Visible = False
'On rend le classeur visible
xlApp.Visible = True
'On créer l'objet onglet dans le nouveau classeur créé
Set xlSheet = xlBook.Worksheets(1)
'On affecte un nom aux l'onglets

xlSheet.Name = "Informations"
'on libère l'objet onglet pour pouvoir en créer un nouveau ... etc

Set xlSheet = Nothing

nombredonglet = 1
i = 0
Do
i = i + 1
If Worksheets("Liste Etude").Cells(lignederniereetude, 13 + i) = "X" Then
nombredonglet = nombredonglet + 1
Set xlSheet = xlBook.Worksheets(nombredonglet)
xlSheet.Name = Worksheets("Liste Etude").Cells(3, 13 + i)

Set xlSheet = Nothing
End If
Loop Until i = 8
nombredonglet = nombredonglet + 1
'
Set xlSheet = xlBook.Worksheets(nombredonglet)
xlSheet.Name = "Soustraitance"
Set xlSheet = Nothing
'
'....... On donne un nom à chaque onglets
nombredonglet = nombredonglet + 1

Set xlSheet = xlBook.Worksheets(nombredonglet)
xlSheet.Name = "Résultats"
Set xlSheet = Nothing
'
'On remet la propriété de l'application à 3 (par défaut)
xlApp.SheetsInNewWorkbook = nombredonglet
'On ferme l'application
xlApp.Quit

creationfeuilleetude.Hide

End Sub

en fait j'ai une userform qui me demande quelle feuille type j'ai besoin pour ma nouvelle étude, je coche les feuilles (les réponses sont envoyées dans une feuilles excel)et par la suite quand j'appuis sur terminer, j'ai un nouveau classeur qui apparait et je souhaiterai copier les feuilles que j'ai sélectionné dans ma userform et les copier dans le nouveau classeur qui porte le code de la nouvelle étude le problème c'est que le nom change à chaque fois tout comme les feuilles à copier.

Réponse 3 / 6

Le Pingou Messages postés 12104 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 10 juin 2024 1 442
29 nov. 2013 à 16:05

Bonjour,
La seule lecture de votre code ne me permet de vous donner une proposition satisfaisante.....à mois de reconstruire votre application..... !
Ne serait-il pas plus simple de mettre votre fichier sur https://www.cjoint.com/ et poster le lien !

Réponse 4 / 6

Le Pingou Messages postés 12104 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 10 juin 2024 1 442
29 nov. 2013 à 17:41

Bonjour,
Je reviens une fois car le code que j'ai proposé est correct, il faut simplement l'adapté à votre application: uniquement ces lignes:

Sheets(Array("Feuil2", "Feuil3")).Copy
' *** adapter le cheminselone votre répertoire
    ActiveWorkbook.SaveAs Filename:="C:\votre chemin\NouvCla_2f.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

julien69960
6 déc. 2013 à 15:53

Merci pour votre réponse cela fonctionne, mais j'ai une dernière question à vous poser,
mon problème est de placer des variables dans l'intitulé Sheets(Array(...); si vous voulez les feuilles que j'ai à copier ne sont jamais les mêmes.

julien69960
6 déc. 2013 à 15:55

autre question:

je souhaite savoir comment vous faites pour faire apparaître le signe " sur une msgbox?

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

Le Pingou Messages postés 12104 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 10 juin 2024 1 442
Modifié par Le Pingou le 6/12/2013 à 17:26

Bonjour,
Oui bien sur, mais je vous renvoie sur ce message... !

Salutations.
Le Pingou

Réponse 6 / 6

Le Pingou Messages postés 12104 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 10 juin 2024 1 442
6 déc. 2013 à 22:48

Bonjour,
C'est dur la vie.....
Le principe est de récupérer le nom des feuilles dans une variable et ensuite d'utiliser cette dernière pour la copie des feuilles. Voir procédure ci-après :

Sub CopyFeuilleNouvCla()
Dim TbSh() As String
For c = 1 To 2 '(2 = le nombre de feuilles selon votre choix)
ReDim Preserve TbSh(c - 1)
    TbSh(c - 1) = "Feuil4" 'Feuil4 doit être remplacer par l'adresse ou se  trouve les nom de feuilles....?
Next c
Sheets(TbSh).Copy
' *** adapter le cheminselone votre répertoire "C:\votre chemin\NouvCla_2f.xlsx"
    ActiveWorkbook.SaveAs Filename:="C:\Users\PJP\Desktop\NouvCla_2f45.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub

Discussions similaires

lien copié

Copier une feuille d'un classeur qui s'actualise

Reporter valeur sur autre feuille avec critere

Comment retrouver des lien copier sur sont téléphone

Impossible d'exécuter les macros

Discussions similaires

Newsletters