Lien entre macro

Bonjour,

Je n’arrive pas à lier les macros…

Dans l’excel ci-joint le bouton dossier permet de sélectionner un dossier en particulier dans le répertoire. Le lien du dossier s’inscrit en cellule B6.

Ce que je n’arrive pas à faire c’est appliquer le code ci-dessous à tous les fichiers Excel du dossier sélectionner en B6. J’ai créer un bouton démarrer qui doit normalement permettre d’aller chercher le lien en B6 et appliquer le code ci-dessous.

Sub CopieDonnees()
Application.DisplayAlerts = False
Range("C353:BV383").Copy Range("C8:BW38")
Range("C353:BV383").Copy Range("C40:BW67")
Range("C353:BV383").Copy Range("C69:BW99")
Range("C353:BV383").Copy Range("C101:BW130")
Range("C353:BV383").Copy Range("C132:BW162")
Range("C353:BV383").Copy Range("C164:BW193")
Range("C353:BV383").Copy Range("C195:BW225")
Range("C353:BV383").Copy Range("C227:BW257")
Range("C353:BV383").Copy Range("C259:BW289")
Range("C353:BV383").Copy Range("C290:BW320")
Range("C384:BV384").Copy Range("C321:BW321")
Range("C384:BV384").Copy Range("C258:BW258")
Range("C384:BV384").Copy Range("C226:BW226")
Range("C384:BV384").Copy Range("C163:BW163")
Range("C384:BV384").Copy Range("C100:BW100")
Range("C384:BV384").Copy Range("C39:BW39")
Range("C352:BV384").Copy Range("C289:BW289")
Range("C352:BV384").Copy Range("C194:BW194")
Range("C352:BV384").Copy Range("C131:BW131")
Application.DisplayAlerts = True
End Sub

Pouvez vous m’aider ?

Merci beaucoup !!!!

Bonjour,

Il vous faut indiquer à quel onglet se réfèrent vos cellules. Pour cela, il vous faut instancier une variable Worksheet et rendre paramétrique la procédure Copie_Donnees. A vérifier que l'onglet à mettre à jour est bien l'onglet 1 dans le code.

Sub Traiter_Dossier()

Dim LigneTraitement As Integer
Dim DossierEnCours As String, FichierEnCours As String
Dim WbEnCours As Workbook
Dim ShTraitement As Worksheet, ShEnCours As Worksheet

    On Error GoTo Fin

    Application.DisplayAlerts = False

    Set ShTraitement = Sheets("Traitement")

    With ShTraitement
         DossierEnCours = .Range("B6").Value
         LigneTraitement = 6
         FichierEnCours = Dir(DossierEnCours & "\*.xls*")
    End With

    Do While FichierEnCours <> ""

        Set WbEnCours = Workbooks.Open(DossierEnCours & "\" & FichierEnCours)
        Set ShEnCours = WbEnCours.Sheets(1)
        CopieDonnees ShEnCours

        With ShTraitement
             .Cells(LigneTraitement, 7).Value = FichierEnCours
             .Hyperlinks.Add Anchor:=.Cells(LigneTraitement, 8), Address:=DossierEnCours & "\" & FichierEnCours, TextToDisplay:=FichierEnCours
             .Cells(LigneTraitement, 9).Value = "Ok"
             LigneTraitement = LigneTraitement + 1
        End With

        WbEnCours.Close savechanges:=True
        Set WbEnCours = Nothing: Set ShEnCours = Nothing

        FichierEnCours = Dir()
    Loop

     Application.DisplayAlerts = True
     MsgBox "Fin de traitement !", vbInformation

    GoTo Fin

Fin:

    Application.DisplayAlerts = True
    Set ShTraitement = Nothing
    Set WbEnCours = Nothing: Set ShEnCours = Nothing

End Sub

Sub CopieDonnees(ByVal ShEnCours2 As Worksheet)

    With ShEnCours2
        .Range("C353:BV383").Copy .Range("C8")
        .Range("C353:BV383").Copy .Range("C40")
        .Range("C353:BV383").Copy .Range("C69")
        .Range("C353:BV383").Copy .Range("C101")
        .Range("C353:BV383").Copy .Range("C132")
        .Range("C353:BV383").Copy .Range("C164")
        .Range("C353:BV383").Copy .Range("C195")
        .Range("C353:BV383").Copy .Range("C227")
        .Range("C353:BV383").Copy .Range("C259")
        .Range("C353:BV383").Copy .Range("C290")
        .Range("C384:BV384").Copy .Range("C321")
        .Range("C384:BV384").Copy .Range("C258")
        .Range("C384:BV384").Copy .Range("C226")
        .Range("C384:BV384").Copy .Range("C163")
        .Range("C384:BV384").Copy .Range("C100")
        .Range("C384:BV384").Copy .Range("C39")   ' ?
        .Range("C352:BV384").Copy .Range("C289")
        .Range("C352:BV384").Copy .Range("C194")
        .Range("C352:BV384").Copy .Range("C131")
    End With

End Sub