macro qui copie une feuille du classeur sur un autre classeur Fermé

Question

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.

Le Pingou · Answer

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

julien69960 · Answer

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.

Le Pingou · Answer

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 !

Le Pingou · Answer

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

Le Pingou · Answer

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

Le Pingou · Answer

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 StringFor 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 cSheets(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:=FalseEnd Sub

Macro qui copie une feuille du classeur sur un autre classeur

6 réponses

Discussions similaires