Copier modules dans un nouveau workbook

Public Sub CopyModule(SourceWB As Workbook, strModuleName As String, TargetWB As Workbook)

    ' Description:  copies a module from one workbook to another
    ' example: CopyModule Workbooks(ThisWorkbook), "Module2",
    '          Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
    ' Notes:   If Module to be copied already exists, it is removed first,
    '          and afterwards copied

    Dim strFolder                       As String
    Dim strTempFile                     As String
    Dim FName                           As String

    If Trim(strModuleName) = vbNullString Then
        Exit Sub
    End If

    If TargetWB Is Nothing Then
        MsgBox "Error: Target Workbook " & TargetWB.Name & " doesn't exist (or closed)", vbCritical
        Exit Sub
    End If

    strFolder = SourceWB.Path
    If Len(strFolder) = 0 Then strFolder = CurDir

    ' create temp file and copy "Module2" into it
    strFolder = strFolder & "\"
    strTempFile = strFolder & "~tmpexport.bas"

    On Error Resume Next
    FName = Environ("Temp") & "\" & strModuleName & ".bas"
    If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
        Err.Clear
        Kill FName
        If Err.Number <> 0 Then
            MsgBox "Error copying module " & strModuleName & "  from Workbook " & SourceWB.Name & " to Workbook " & TargetWB.Name, vbInformation
            Exit Sub
        End If
    End If

    ' remove "Module2" if already exits in destination workbook
    With TargetWB.VBProject.VBComponents
        .Remove .Item(strModuleName)
    End With

    ' copy "Module2" from temp file to destination workbook
    SourceWB.VBProject.VBComponents(strModuleName).Export strTempFile
    TargetWB.VBProject.VBComponents.Import strTempFile

    Kill strTempFile
    On Error GoTo 0

End Sub

Call CopyModule(WB1, "Module2", WB2)

Bonjour TeddyBear37,

Pourquoi t'embêter pendant des heures.

Tu sélectionnes, en le mettant en surbrillance le nom de ton 1ier module lorsque tu est sur l'éditeur Vba.

Puis avec la souris tu fais glisser celui sur l'autre classeur dont la structure VBA project apparaît en même endroit.

Cela prends 1 seconde.

Bonjour X cellus

Je m'embete car j'aimerais faire cela automatiquement.

En faite, je souhaite faire la copie de quelques feuilles d'un classeur A, sur un nouveau classeur B.

Mais lorsque je crée le classeur B (par VBA) et que je copie les feuilles, les boutons présent dans ces dernieres ne sont plus utilisables (classeur A etant fermé) car les modules du classeur A ne sont pas automatiquement copiés.

J'ai donc besoin de faire cela automatiquement pour éviter le glisser déposer à chaque copie...

A nouveau,

Fais une copie de ton classeur A en entier (Même par VBA...) en le nommant B ou comme tu souhaites.

Puis supprime (Même par VBA...) après les feuilles qui ne t'intéressent plus sur ce classeur B.

Cela te prendra moins de temps.

Merci bien, j'y avais pas pensé, je vais essayer cela

Sub enregistrerDevisEnXLS()

    Dim wb1 As Workbook, wb2 As Workbook
    Set wb1 = ThisWorkbook

    Application.DisplayAlerts = False
    Dim nomFichier As String

    nomFichier = cheminFichierDevis & Range("h1") & ".xlsm"

    wb1.SaveAs Filename:=nomFichier, FileFormat:=52, CreateBackup:=False

    ActiveWorkbook.Sheets("tab1").Delete
   ActiveWorkbook.Sheets("tab2").Delete

    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=True

End Sub

Finalement, je pensais pouvoir copier facilement un classeur et supprimer les feuilles voulues, mais je n'y arrive pas avec ce code.

Le résultat que j'obtiens : Le classeur wb1 se ferme et wb2 reste ouvert, les feuilles "tab1" et 2 non supprimées.

Je souhaite pourtant laisser ouvert wb1 et fermer automatiquement wb2 après suppression des 2 feuilles

Bonsoir TeddyBear37,

Tu dois réaliser une copie de ton premier fichier. Dans la cellule H1 doit être inscris le nom donné à ton deuxième fichier.

Donc avec le code ci-dessous tu auras bien ton premier fichier qui restera ouvert et une copie de celui-ci en un deuxième exemplaire sans les feuilles précitées.

Sub CopFich()
'Copie d'un premier fichier en un deuxième identique sauf sur 2 feuilles
Dim wb1, wb2 As Workbook
Set wb1 = ThisWorkbook
'Le chemin correspond au premier classeur ouvert qui est celui à copier
ChemFichDevis = wb1.Path
'Le Range H1 de la feuille active comporte le nom du wb2 sans extension (type du fichier)
Nomfich2 = ActiveSheet.Range("H1") & ".xlsm"
'Copie du premier fichier
ActiveWorkbook.SaveCopyAs ChemFichDevis & "\" & Nomfich2
'Onverture du deuxième fichier après l'avoir copié par la ligne précédente
Workbooks.Open ChemFichDevis & "\" & Nomfich2
Set wb2 = Workbooks(Nomfich2)
'Suppression de deux feuilles sur ce deuxième fichier en bloquant le message d'alerte (confirmation)
Application.DisplayAlerts = False
wb2.Sheets("Tab1").Delete
wb2.Sheets("Tab2").Delete
'Fermeture de ce deuxième fichier
wb2.Close SaveChanges:=True
Application.DisplayAlerts = True
End Sub

Bonsoir X cellus, merci de prendre le temps d’écrire tout ce code.

Je m'en suis donc inspiré avec le code ci-dessous, mais j'obtiens une erreur que je n'arrive pas à résoudre

Sub enregistrerDevisEnXLS()

    If Range("h1").Value = "" Then MsgBox ("H1 est vide"): Exit Sub

    Dim wbCreationDevis, wbXLS As Workbook
    Set wbCreationDevis = ThisWorkbook
    Dim ws As Worksheet

    Dim nomFichier As String

    nomFichier = cheminFichierDevis & Range("h1") & ".xlsm"
    wbCreationDevis.SaveCopyAs nomFichier

    Workbooks.Open nomFichier
    Set wbXLS = Workbooks(nomFichier)

    Application.DisplayAlerts = False

        For Each ws In wbXLS.Worksheets

            If ws.Name = "ACCUEIL" Or ws.Name = "DEVIS" Then
            GoTo ContinueLoop
            End If

            ws.Delete

ContinueLoop:
        Next ws

    'fermetture du fichier
    wbXLS.Close savechanges:=True
    Application.DisplayAlerts = True

End Sub

erreur qui pointe sur Set wbXLS = Workbooks(nomFichier)

Bonjour TeddyBear37,

CheminFichierDevis doit être forcément de type string mais as tu précisé cette donnée.

Ce chemin doit être vide.

Place un Msgbox CheminFichierDevis dans ton code avant la ligne nom fichier = afin de voir.

Bonjour X Cellus

J'avais déjà vérifié cela et malheureusement, le chemin n'est pas vide, donc je ne sais pas quoi faire d'autres...

Mon chemin (nomFichier) ressemble à : E:\1 - DOSSIER\DEVIS10.24.xlsm

La question que je me posais, même si cela ne m'a jamais posé de problème dans d'autres modules, est est-ce que la syntaxe de ce chemin ne pourrai pas poser problème à un moment donné ?

A nouveau,

J'ai peu de temps pour te répondre car j'ai fini ma pause.

Mais un chemin n'a pas d'extension...

Je suppose que ton deuxième fichier sera dans le même chemin que ton premier fichier.

Donc tu peux utiliser ThisWorkbook.path pour contrôler ton chemin comme je l'ai fait dans mon code précédent.

Merci X cellus, j'ai finalement reussi ! Vous avez vu juste, je me mélangeais les pinceaux dans l'utilisation des fonctions qui nécessitent un nom de fichier simple ou un nom de fichier+chemin...

Par contre nouveau problème, sur le nouveau classeur obtenu, certaines cellules contiennent des erreurs car les formules qu'elles contiennent n'ont plus accès aux onglets supprimés.

Y'a t'il un moyen de faire la copie du classeur 1 en classeur 2 tout en gardant les valeurs des cellules du classeur 1 mais sans les formules ? histoire d'éviter les erreurs ? (#N/A)

Un peu comme la fonction

ws.Cells.PasteSpecial xlPasteValues

Merci