Macro pour recopier feuilles vers d'autres classeurs

[Rénato]

Bonjour le forum

J'essaye vainement de réaliser une macro qui exporte le résultat du mois de novembre des 3 feuilles (LaveLinge, Cuisiniere et Frigo) de mon classeur vers 3 classeurs préexistants nommés du nom de ces feuilles dans un répertoire "C:\Users\MesDocuments\Résultats"
Les 3 classeurs contiennent tous 12 feuilles nommées de JANVIER à DECEMBRE.
L'objectif de la macro étant de copier :
1) le contenu de la feuille "LaveLinge" vers la feuille "Novembre" du classeur nommée "LaveLinge"
2)le contenu de l'onglet "Cuisinière " vers la feuille "Novembre" du classeur nommée "Cuisinière"
3)le contenu de l'onglet "Frigo" vers la feuille "Novembre" du classeur nommé "Frigo"

Plus bas j'ai essayé de composer avec des morceaux de script trouvés ici ou là, mais sans succès.

Je vous joins mon fichier, si l'un d'entre vous pouvais me donner des pistes ?
Merci pour votre aide

O.

Sub Ajout_Données_Classeurs_Destination()

Dim sh As Worksheet
Dim lenom As String
Dim lenom2 As String
Dim nomfichier As Workbook
Dim NomDeLaFeuille As Worksheet
Dim Thepath As String
Dim Moistraitement As String

For Each sh In Sheets(Array(Worksheets.Count - 3)) <--- pour ne traiter que les 3 feuilles voulues.

sh.Select
Application.CutCopyMode = False
Cells.Select
Selection.Copy
'sh.Copy
lenom = sh.Name
lenom2 = lenom & ".xlsx"
On Error GoTo 99
Workbooks.Open Filename:="CC:\Users\MesDocuments\Résultats" && "\" & lenom2
Worksheets(NomDeLaFeuille).Select
ActiveSheet.past
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\MesDocuments\Résultats" & "\" & lenom2, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close
99 Next sh
MsgBox "Les classeurs ont été mis à jour dans le repertoire destination"
End Sub

 

[Nairolf]

Re : Macro pour recopier feuilles vers d'autres classeurs

Salut Rénato,

Essaye avec ce code (modifications de ton code):
Sub Ajout_Données_Classeurs_Destination()
Dim sh As Worksheet
Dim lenom As String
Dim lenom2 As String
Dim nomfichier As Workbook
Dim NomDeLaFeuille As Worksheet
Dim Thepath As String
Dim Moistraitement As String
For Each sh In Worksheets

If sh.Name <> "Feuille de travail" And sh.Name <> "Base de données" Then

sh.Select
Application.CutCopyMode = False
Cells.Select
Selection.Copy
lenom = sh.Name
lenom2 = lenom & ".xlsx"
On Error GoTo fin
Workbooks.Open Filename:="C:\Users\" & lenom2
Worksheets("Novembre").Select
Cells.Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
fin:

End If

Next sh
MsgBox "Les classeurs ont été mis à jour dans le repertoire destination"
End Sub

 

[Robert]

Re : Macro pour recopier feuilles vers d'autres classeurs

Bonjour le fil, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim o As Object 'déclare la variable o (Onglets)
Dim cl As Workbook 'déclare la variable cl (CLasseur)
Dim od As Object 'déclare la variable od (Onglet de Destination)

For Each o In Sheets 'boucle sur tous les onglets du classeur
    'condition 1 : si le nom de l'onglet est différent de "Feuille de travail" ou de "Base de données"
    If Not o.Name = "Feuille de travail" And Not o.Name = "Base de données" Then
        On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
        Set cl = Workbooks(o.Name & ".xlsx") 'définit le classeur cl (génère une erreur si le classeur n'est pas ouvert)
        If Err <> 0 Then 'condition 2 : si une erreur a été générée
            Err = 0 'annule l'erreur
            Workbooks.Open Filename:="C:\Users\Mes Documents\Résultats\" & o.Name & ".xlsx" 'ouvre le classeur
            Set cl = ActiveWorkbook 'définit le classseur cl
        End If 'fin de la condition 2
        On Error GoTo 0 'annule la gestion des erreurs
        Set od = cl.Sheets(o.Range("C1").Value) 'définit l'onglet de destination
        o.UsedRange.Copy od.Range("A1") 'copie et colle la plage des cellules éditée
        cl.Close SaveChanges:=True 'ferme le classeur en enregistrant les modifications
    End If 'fin de la condition 1
Next o 'prochain onglet de la boucle
MsgBox "Les classeurs ont été mis à jour dans le repertoire destination" 'message
End Sub

Non testé, la flemme de créer les tois fichiers... Vérifie le chemin dans la ligne :

Workbooks.Open Filename:="C:\Users\Mes Documents\Résultats\" & o.Name & ".xlsx" 'ouvre le classeur

 

[Rénato]

Re : Macro pour recopier feuilles vers d'autres classeurs

Merci beaucoup à vous deux Robert et Nairolf, je teste ceci et vous donnerai des nouvelles. Bonne soirée