Copie de range dans différents fichiers et classeurs

  • Initiateur de la discussion Initiateur de la discussion Turbo
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

T

Turbo

Guest
Bonjour a tous

Petite explication de mon application :

J'ai un fichier source, avec mes bouttons et des macros qui devrait copier une plage de cellule ( de ce fichier source ) vers un autre fichier destination comprenant plusieurs feuilles de calcul.
La copie se fait en prenant en compte la date inscrite sur le fichier source, et selon la valeur de cette date, la copie se fait sur différentes feuilles de calcul du fichier de destination.

Les feuilles de calculs du fichier destination correspondent aux différents mois.

Si vous avez rien compris, faites m'en part, je tacherai d'être plus explicite.

Les fichiers en question :
 

Pièces jointes

Re : Copie de range dans différents fichiers et classeurs

Oui et merci de m'avoir trouvé une solution 😉

Mais j'ai un peu avancé, j'ai rajouté certaines options, et d'autres détails, et maintenant ca ne marche plus 🙁

Donc j'aimerai que quelqu'un m'explique ce que n'aime pas le compilateur.

Voici le code :

Code:
Private Sub Enregistrer_Click()
        
    Dim Chemin$, Wbk As Workbook
    Dim Nb_FeuilleCalcul As Integer
    Dim Mois As String
    Chemin = "G:\Campbell's Liebig\Test\Synthése Aôut, Sept Modif 07BIS.xls"
    Nb_FeuilleCalcul = ThisWorkbook.Worksheets.Count
    If Not DejaOuvert(Chemin) Then 'Si le fichier synthèse n'est pas ouvert
        Workbooks.Open Chemin
        Set Wbk = Workbooks(Dir$(Chemin))
        MsgBox ("Ouverture du fichier " & Wbk.Name)
        Mois = UCase(Left(Workbooks("Formulaire heures modif 08.xls").Sheets("Mensuel").Cells(1, 25).Text, 3)) & Right(Workbooks("Formulaire heures modif 08.xls").Sheets("Mensuel").Cells(1, 25).Text, 2)
        Mois = OteAccents(Mois)
        Nb_FeuilleCalcul = Wbk.Worksheets.Count 'Compte le nombre de feuille de calcul du fichier de synthèse
        While Mois <> Worksheets(Nb_FeuilleCalcul).Name
                MsgBox ("Recherche des feuilles de calcul qui porte le nom : " & Mois)
                Nb_FeuilleCalcul = Nb_FeuilleCalcul - 1
        Wend
                Workbooks("Formulaire heures modif 08.xls").Sheets("Mensuel").Range("AK7:AK81").Copy
                Workbooks(Wbk.Name).Activate
                Select Case Workbooks("Formulaire heures modif 08.xls").Sheets("Mensuel").Cells(3, 29).Value
                Case Is = "MLB"
                Sheets(Mois).Range("B7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "IB"
                Sheets(Mois).Range("C7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "MHR"
                Sheets(Mois).Range("D7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "FF"
                Sheets(Mois).Range("E7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "Gry"
                Sheets(Mois).Range("F7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "CR"
                Sheets(Mois).Range("H7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "GB"
                Sheets(Mois).Range("I7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "OA"
                Sheets(Mois).Range("K7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "HD"
                Sheets(Mois).Range("L7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "PM"
                Sheets(Mois).Range("M7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "SG"
                Sheets(Mois).Range("N7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "KI"
                Sheets(Mois).Range("O7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "CM"
                Sheets(Mois).Range("P7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "AR"
                Sheets(Mois).Range("Q7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "FE"
                Sheets(Mois).Range("R7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Is = "PF"
                Sheets(Mois).Range("S7").Select
                Selection.PasteSpecial Paste:=xlValues
                Case Else
                    MsgBox ("Initiale inconnue !!!")
                End Select
    Else
        Set Wbk = Workbooks(Dir$(Chemin))
        MsgBox ("Veuillez fermer le fichier " & Wbk.Name)
    End If
    
End Sub
 
Re : Copie de range dans différents fichiers et classeurs

Bonjour a tous

Petit up car j'aurai vraiment besoin que quelqu'un m'explique pourquoi la copie d'un fichier vers un autre ne marche plus.

Le code est un peu long, mais en fait il n'y a pas grand chose, il répète plusieurs fois la même instruction.

Merci a vous 😉
 
Re : Copie de range dans différents fichiers et classeurs

Voila j'ai réussi a faire fonctionner mon code çi-dessus, mais concrètement je n'ai pas compris ce que ca changé ( entre le nouveau code et l'ancien ).

Le code qui marche :

Code:
Private Sub Enregistrer_Click()
        
    Dim Chemin$, Wbk As Workbook
    Dim Nb_FeuilleCalcul As Integer
    Dim Mois As String
    Chemin = "G:\Campbell's Liebig\Test\Synthése Aôut, Sept Modif 07BIS.xls"
    Nb_FeuilleCalcul = ThisWorkbook.Worksheets.Count
    If Not DejaOuvert(Chemin) Then 'Si le fichier synthèse n'est pas ouvert
        Workbooks.Open Chemin
        Set Wbk = Workbooks(Dir$(Chemin))
        MsgBox ("Ouverture du fichier " & Wbk.Name)
        Mois = UCase(Left(Workbooks("Formulaire heures modif 08.xls").Sheets("Mensuel").Cells(1, 25).Text, 3)) & Right(Workbooks("Formulaire heures modif 08.xls").Sheets("Mensuel").Cells(1, 25).Text, 2)
        Mois = OteAccents(Mois)
        Nb_FeuilleCalcul = Wbk.Worksheets.Count 'Compte le nombre de feuille de calcul du fichier de synthèse
        While Mois <> Worksheets(Nb_FeuilleCalcul).Name
                MsgBox ("Recherche des feuilles de calcul qui porte le nom : " & Mois)
                Nb_FeuilleCalcul = Nb_FeuilleCalcul - 1
        Wend
                Workbooks("Formulaire heures modif 08.xls").Sheets("Mensuel").Range("AK7:AK81").Copy
                Workbooks(Wbk.Name).Activate
                Select Case Workbooks("Formulaire heures modif 08.xls").Sheets("Mensuel").Cells(3, 29).Value
                Case Is = "MLB"
                Sheets(Mois).Range("B7").PasteSpecial Paste:=xlValues
                Case Is = "IB"
                Sheets(Mois).Range("C7").PasteSpecial Paste:=xlValues
                Case Is = "MHR"
                Sheets(Mois).Range("D7").PasteSpecial Paste:=xlValues
                Case Is = "FF"
                Sheets(Mois).Range("E7").PasteSpecial Paste:=xlValues
                Case Is = "Gry"
                Sheets(Mois).Range("F7").PasteSpecial Paste:=xlValues
                Case Is = "CR"
                Sheets(Mois).Range("H7").PasteSpecial Paste:=xlValues
                Case Is = "GB"
                Sheets(Mois).Range("I7").PasteSpecial Paste:=xlValues
                Case Is = "OA"
                Sheets(Mois).Range("K7").PasteSpecial Paste:=xlValues
                Case Is = "HD"
                Sheets(Mois).Range("L7").PasteSpecial Paste:=xlValues
                Case Is = "PM"
                Sheets(Mois).Range("M7").PasteSpecial Paste:=xlValues
                Case Is = "SG"
                Sheets(Mois).Range("N7").PasteSpecial Paste:=xlValues
                Case Is = "KI"
                Sheets(Mois).Range("O7").PasteSpecial Paste:=xlValues
                Case Is = "CM"
                Sheets(Mois).Range("P7").PasteSpecial Paste:=xlValues
                Case Is = "AR"
                Sheets(Mois).Range("Q7").PasteSpecial Paste:=xlValues
                Case Is = "FE"
                Sheets(Mois).Range("R7").PasteSpecial Paste:=xlValues
                Case Is = "PF"
                Sheets(Mois).Range("S7").PasteSpecial Paste:=xlValues
                Case Else
                    MsgBox ("Initiale inconnue !!!")
                End Select
    Else
        Set Wbk = Workbooks(Dir$(Chemin))
        MsgBox ("Veuillez fermer le fichier " & Wbk.Name)
    End If
    
End Sub

En résumé, j'ai remplacé :

Code:
Case Is = "CR"
Sheets(Mois).Range("H7").Select
Selection.PasteSpecial Paste:=xlValues

par

Code:
Case Is = "CR"
Sheets(Mois).Range("H7").PasteSpecial Paste:=xlValues

( pour tout mes cases bien sur ) et l'érreur me disant que le select de range avait échoué a disparue.

Ce n'est plus important, mais si quelqu'un a comprit pourquoi le compilateur interpretait une erreur, qu'il n'hésite pas a venir en parler sur ce topic.

Bonne journée a tous 😉
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
2
Affichages
677
Retour