Créer VBA qui copie une feuille Excel dans un autre fichier

Bonjour,

J'aimerais avoir une macro qui (depuis mon fichier excel, exemple "Fichier.de.travail")

1) me demande de sélectionner un fichier Excel (par exemple fichier "Source")

2) Efface les macro présents dans mon fichier de travail "Fichier.de.travail"

2) Copie la première feuille du fichier avec ses macros (et sa mise en page) et la colle dans mon fichier de travail "Fichier.de.travail".

En vous remerciant,

Bonjour,

demande un peu particulière car travailler sur les macros elles-mêmes via un code macro n'est pas courant mais possible !

pour le point 2, tu parles de macros de la première feuille ... ces macros sont bien dans le "module-feuille" et non dans un module général du fichier ?

Bonjour,

Merci de ton intérêt pour ma demande.

Le point 2 concerne les macros générales.

J'imagine que dans un premier temps la macro va devoir enregistrer les macros présentes dans le classeur du fichier "fichier.de.travail" pour ensuite insérer la/les nouvelle(s) macro issues du classeur "Source" . Puis effacer les macros enregistrées précédemment.

Une demande du même type au même moment !

https://forum.excel-pratique.com/excel/transfert-de-macro-d-un-classeur-a-vers-classeur-b-fonction-c...

à adapter puisque tu parles de module général

Un premier essai en partant du fichier source

Sub dupliquer()
' cocher la réference Microsoft Visual Basic for Applications Extensibility 5.3
Dim Wb1 As Workbook, vbCmp1 As Object
Dim Wb2 As Workbook, vbCmp2 As Object
Set Wb1 = ThisWorkbook
Set Wb2 = Workbooks.Add
Wb1.Sheets(1).Cells.Copy Destination:=Wb2.Sheets(1).Cells(1, 1)
For Each vbCmp1 In Wb1.VBProject.VBComponents
    If vbCmp1.Name <> "ModuleRecopie" Then
        Set vbCmp2 = Wb2.VBProject.VBComponents.Add(1)
        RecopierMacro vbCmp1, vbCmp2
    End If
Next
End Sub

Sub RecopierMacro(de As VBComponent, vers As VBComponent)
    With vers.CodeModule
        For i = 1 To de.CodeModule.CountOfLines
            .InsertLines i, de.CodeModule.Lines(i, 1)
        Next
    End With
End Sub

Pour importer cette fois-ci comme tu le demandes

Sub importer()
' cocher la réference Microsoft Visual Basic for Applications Extensibility 5.3
Dim Wb1 As Workbook, vbCmp1 As Object
Dim Wb2 As Workbook, vbCmp2 As Object
Dim choix As Variant
    choix = Application.GetOpenFilename("Fichiers (*.xlsm*),*.xlsm")
    If choix = False Then Exit Sub
    Set Wb1 = Workbooks.Open(choix)
    Set Wb2 = ThisWorkbook
    Wb2.Sheets(1).Cells.Clear
    supprimer Wb2

    Wb1.Sheets(1).Cells.Copy Destination:=Wb2.Sheets(1).Cells(1, 1)
    For Each vbCmp1 In Wb1.VBProject.VBComponents
        Set vbCmp2 = Wb2.VBProject.VBComponents.Add(1)
        RecopierMacro vbCmp1, vbCmp2
    Next
End Sub

Sub RecopierMacro(de As VBComponent, vers As VBComponent)
    With vers.CodeModule
        For i = 1 To de.CodeModule.CountOfLines
            .InsertLines i, de.CodeModule.Lines(i, 1)
        Next
    End With
End Sub

Sub supprimer(wb As Workbook)
Dim VBComp As Object
Dim VBComps As Object
    Set VBComps = wb.VBProject.VBComponents
    For Each VBComp In VBComps
        If VBComp.Name <> "ModuleRecopie" Then
            If VBComp.Type = 1 Then VBComps.Remove VBComp
        End If
    Next VBComp
End Sub

Bonjour,

Merci de ton retour Steelson, et de ton intérêt pour ma requête.

Message d'erreur, pourrais-tu me débloquer ?

• As-tu coché la référence indiquée dans la deuxième ligne de la macro ?
• As-tu approuvé l'accès au modèle d'objet VBA

Merci, oui effectivement ce n'était pas coché !

Merci encore a toi !! top !