Execution interrompue lors de la copie d'onglets vers un fichier créé

Bonjour à tous

Je me décide à poser la question sur un forum car je n'arrive pas à trouver l'explication à mon problème.

Je souhaite via l'appui sur un bouton effectuer les traitements suivants :

1°) Si un fichier est présent dans un répertoire donné, le supprimer

2°) Puis je crée un nouveau fichier dans lequel je viens copier 3 onglets présents dans le classeur qui contient la macro que je souhaite écrire

J'ai le code suivant qui se lance suite à une appui sur un bouton.

Sub BoutonMiseAjourFichier2()

Dim monclasseur As String
Dim monrep As String
Dim madate As String
Dim monfichier As String
' monclasseur : nom du classeur qui contient la macro
monclasseur = ActiveWorkbook.name

'monrep : répertoire qui contient le fichier que je souhaite créer

monrep = "D:\Professionnel\Mon Projet\Diffusion Données"
'je teste si le fichier que je souhaite créer existe, si oui je le supprime

If Len(Dir(monrep & "\Diffusion Données.xlsx")) > 0 Then
Kill monrep & "\" & "Diffusion Données.xlsx"
End If

'je crée un nouveau classeur et je l'enregistre dans mon répertoire
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=monrep & "\Diffusion Données.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'maintenant je viens récupérer les trois onglets A,B,C pour en faire une copie dans mon fichier Diffusion Données.xlsx

Windows(monclasseur).Activate
Sheets("A").Select
Sheets("A").Copy Before:=Workbooks("Diffusion Données.xlsx").Sheets(1)
Windows(monclasseur).Activate
Sheets("B").Select
Sheets("B").Copy Before:=Workbooks("Diffusion Données.xlsx").Sheets(1)
Windows(monclasseur).Activate
Sheets("C").Select
Sheets("C").Copy Before:=Workbooks("Diffusion Données.xlsx").Sheets(1)
ActiveWorkbook.Save
ActiveWorkbook.Close

Windows(monclasseur).Activate
MsgBox ("Mise à jour fichier effectuée")

End Sub

Lorsque j'exécute le code suivant, j'ai le message d'erreur : Execution interrompue sur la ligne en gras : Windows(monclasseur).Activate

image

Si quelqu'un à une idée d'où peut provenir le problème ?

Merci

Fihu

Bonjour, macro bien longue et répétitive. pourquoi ne pas copier directement les trois onglets dans un nouveau fichier ?

Inutile de créer d'abord un nouveau fichier vide.

( Remplacer dans le code le nom des feuilles par les votres. )

et vérifier si votre répertoire "Diffusion Données" existe ?

Sub Macro1()
Dim monrep As String
Dim monfichier As String

'monrep : répertoire qui contient le fichier que je souhaite créer
monrep = "D:\Professionnel\Mon Projet\Diffusion Données\"

' Nom du fichier et chemin complet à tester
monfichier = monrep & "Diffusion Données.xlsx"

'je teste si le fichier que je souhaite créer existe, si oui je le supprime
If monfichier <> "" And Len(Dir(monfichier)) > 0 Then
Kill monfichier

End If

Sheets(Array("FeuilN1", "FeuilN2", "FeuilN3")).Copy
ActiveWorkbook.SaveAs Filename:=monrep & "Diffusion Données.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close

MsgBox ("Mise à jour fichier effectuée")

End Sub
Rechercher des sujets similaires à "execution interrompue lors copie onglets fichier cree"