Exporter une feuille d'un classeur vers un autre classeur

Bonjour au forum,

Pour la gestion des horaires à mon travail, j'utilise 2 fichiers Excel, le 1er (horaire projet) qui comporte 52 feuilles (correspondant au nombre de semaine et sur lesquelles je fais plusieurs modifications à l'avance), et le 2ième (horaire) que je partage sur tous les postes de mon taf et qui est effectif, c'est à dire que lorsque je suis sûr des horaires que j'ai rentré sur mon 1er fichier, je copie et colle la feuille sur le 2ieme fichier pour que tous les collaborateurs puissent visualiser leurs horaires.

J'aimerais automatiser ce copier coller via un bouton VBA dont voici le code que j'ai fais :

Dim sh As Worksheet, sh2 As Worksheet
     Dim NomFeuilleDestination As String
     Set sh = Sheets("Semaine 1")                        'Feuille à copier

     NomFeuilleDestination = "Semaine 1"

     'Ouvrir le classeur destination
     Workbooks.Open Filename:=ThisWorkbook.Path & "\Horaire.xlsm"

     ' Empêcher les avertissements
     Application.DisplayAlerts = False

     ' Eviter le message d'erreur si la feuille de destination n'existe pas
     On Error Resume Next

     ' Tester si la feuille Destination existe
     Set sh2 = ActiveWorkbook.Sheets(NomFeuilleDestination)

     ' Si elle existe on l'a supprime
     If Not sh2 Is Nothing Then sh2.Delete

     'Rétablir la gestion normale des erreurs
     On Error GoTo 0

     ' Rétablir les avertissements
     Application.DisplayAlerts = True

     'Coller la feuille d'origine dans le classeur destination
     sh.Copy After:=Workbooks("Horaire.xlsm").Sheets(1)
     With ActiveSheet
         .UsedRange.Copy
         .UsedRange.Range("A1").PasteSpecial xlPasteValues
         .Name = NomFeuilleDestination
         .Protect Password:="mdp", DrawingObjects:=False, Contents:=True, Scenarios:=False
     End With
     Application.CutCopyMode = False

Je répète donc ce code sur chacune de mes 52 feuilles du fichier "horaire projet" en modifiant le nom de la feuille à exporter à chaque fois (Semaine 1, Semaine 2,...etc).

L'exportation fonctionne pour la "Semaine 1", mais lorsque j'exécute le bouton pour exporter la "Semaine 2", la feuille "Semaine 1" se fait écraser, et je n'arrive pas à saisir pourquoi...

Quelqu'un aurait-il une idée...?

Un tout grand merci d'avance

Bonjour

Nrev74 a écrit :

Quelqu'un aurait-il une idée...?

En joignant les 2 fichiers

Tu y indiques les opérations à faire pour arriver au plantage

Bonjour au forum,

Tout d'abord, veuillez excuser mon absence de ces derniers jours concernant le sujet, je planchais dessus

J'ai trouvé d'ou venait le problème, c'était simplement que je ne sauvegardais pas le fichier de destination à chaque fin de transfert...

Mais j'ai du coup une autre question :

Ce code fonctionne très bien pour un classeur de destination non partagé :

Private Sub CommandButton1_Click()

Dim sh As Worksheet, sh2 As Worksheet
     Dim NomFeuilleDestination As String
     Set sh = Sheets("Semaine 2")                        'Feuille à copier

     NomFeuilleDestination = "Semaine 2"

     'Ouvrir le classeur destination
     Workbooks.Open Filename:=ThisWorkbook.Path & "\Horaire_fof.xlsm"

     ' Empêcher les avertissements excel
     Application.DisplayAlerts = False

     ' Eviter le message d'erreur si la feuille destination n'existe pas
     On Error Resume Next

     ' Tester si la feuille Destination existe
     Set sh2 = ActiveWorkbook.Sheets(NomFeuilleDestination)

     ' Si elle existe on l'a supprime
     If Not sh2 Is Nothing Then sh2.Delete

     'Rétablir la gestion normale des erreurs
     On Error GoTo 0

     ' Rétablir les avertissements
     Application.DisplayAlerts = True

     'Coller la feuille Origine dans le classeur destination
     sh.Copy After:=Workbooks("Horaire_fof.xlsm").Sheets(Sheets.Count)
     With ActiveSheet
         .UsedRange.Copy
         .UsedRange.Range("A1").PasteSpecial xlPasteValues
         .Name = NomFeuilleDestination
         .Protect Password:="mdp", DrawingObjects:=False, Contents:=True, Scenarios:=False
         .Range("D9").Select
     End With
     Application.CutCopyMode = False
     ActiveWorkbook.Save

End Sub

Mais il ne fonctionne pas pour un classeur de destination qui est partagé...

J'aimerais donc savoir s'il est possible de départager le classeur pour permettre la copie puis de le repartager une fois la feuille copiée (le partage est protégé par mot de passe pour info).

Un tout grand merci pour ceux qui pourront/voudront bien m'aider

Nico.

Auriez-vous une idée ?

Bonjour Banzai64,

Je joins 2 fichiers exemple ici

Le fichier Horaire_projet_fof est le fichier "source" et le fichier Horaire_fof est le fichier de destination qui est partagé (mot de passe pour le partage : mdp)

Nico.

Je crée un nouveau post concernant ce problème car c'est un sujet complètement différent

Nico.