Copier modules dans un nouveau workbook
Je suis à la recherche d'un moyen de copier le module d'une feuille 1 vers une feuille 2.
J'ai essayé pour celà le codage ci-dessous trouvé sur le net
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
Malheureusement, lorsque j'essai de l'utiliser avec l'instruction Call CopyModule(WB1, "Module2", WB2)
j'obtiens l'erreur suivante que je n'arrive pas à résoudre depuis quelques heures.Besoin d'aide pour déboguer cela svp.
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