XL 2013 VBA qui copie les données d'un onglet dans un autre onglet en fonction de certains critères

[onyirimba]

Bonjour,

Est-ce que je pourrai obtenir une programmation VBA qui colle l'onglet du fichier PASA0010 dans un onglet du fichier 2200A1 en fonction de certaines conditions ?

1. l'intitulé du fichier à copier " PASA####" commence obligatoirement par "PASA" (car les chiffres de l'intitulé du fichier PASA#### peuvent être amené à changer)
2. les données du fichier PASA0010 soient collées dans l'onglet du mois correspondant dans le fichier 2200A1 en fonction du mois indiqué dans la cellule C2 (qui correspond au 2 dernier chiffres des 6 chiffres) et des mois des onglets du fichier 2200A1 (ex: si dans la cellule C2 il y a indiqué 202201, le mois étant le mois de janvier/01 => les données doivent être collées dans l'onglet 01 du fichier 2200A1)

J'ai joint des fichiers illustratifs
Merci beaucoup pour votre aide

- FICHIER : PASA0010 -

- FICHIER : 2200A1-

 

[JM27]

Bonjour
avant de poster un autre question il aurait été bien de répondre à la précédente.
https://www.excel-downloads.com/thr...isons-dans-un-fichier.20066028/#post-20499012
Le merci est le seul salaire du bénévole!
Qu'en penses tu?

 

[onyirimba]

Bonjour
avant de poster un autre question il aurait été bien de répondre à la précédente.
https://www.excel-downloads.com/thr...isons-dans-un-fichier.20066028/#post-20499012
Le merci est le seul salaire du bénévole!
Qu'en pense tu?

bonjour,
je viens de répondre que la macro fonctionne parfaitement

 

[job75]

Bonjour onyirimba, JM27,

Téléchargez les fichiers joints dans le même dossier (le bureau) et ouvrez le fichier 2200A1.xlsm.

La macro dans ThisWorkbook :

Private Sub Workbook_Activate()
Dim chemin$, fichier$, mois$
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "PASA*.xlsx") '1er fichier PASA du dossier, à adapter
If fichier = "" Then MsgBox "Aucun fichier 'PASA' dans ce dossier...": Exit Sub
Application.ScreenUpdating = False
While fichier <> ""
    On Error Resume Next
    Workbooks(fichier).Close False 'si le fichier est ouvert
    On Error GoTo 0
    Workbooks.Open chemin & fichier 'ouvre le fichier source
    mois = Right(CStr([B2]), 2)
    If Not mois Like "##" Or mois > "12" Then _
        Application.ScreenUpdating = True: [B2].Select: MsgBox "Le mois en B2 n'est pas correct": Exit Sub
    With ThisWorkbook.Sheets(mois)
        Cells.Copy .Cells(1)
        Cells(1).Copy .Cells(1) 'allège la mémoire
        Application.EnableEvents = False 'désactive les évènements
        ActiveWorkbook.Close False 'ferme le fichier source
        Application.EnableEvents = True 'réactive les évènements
        .Visible = xlSheetVisible 'si la feuille est masquée
        Application.Goto .Cells(1), True 'cadrage
    End With
    fichier = Dir 'fichier suivant du dossier
Wend
End Sub

Tous les fichiers .xlsx dont le nom commence par PASA sont copiés.

A+

 

[onyirimba]

Bonjour onyirimba, JM27,

Téléchargez les fichiers joints dans le même dossier (le bureau) et ouvrez le fichier 2200A1.xlsm.

La macro dans ThisWorkbook :

Private Sub Workbook_Activate()
Dim chemin$, fichier$, mois$
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "PASA*.xlsx") '1er fichier PASA du dossier, à adapter
If fichier = "" Then MsgBox "Aucun fichier 'PASA' dans ce dossier...": Exit Sub
Application.ScreenUpdating = False
While fichier <> ""
    On Error Resume Next
    Workbooks(fichier).Close False 'si le fichier est ouvert
    On Error GoTo 0
    Workbooks.Open chemin & fichier 'ouvre le fichier source
    mois = Right(CStr([B2]), 2)
    If Not mois Like "##" Or mois > "12" Then _
        Application.ScreenUpdating = True: [B2].Select: MsgBox "Le mois en B2 n'est pas correct": Exit Sub
    With ThisWorkbook.Sheets(mois)
        Cells.Copy .Cells(1)
        Cells(1).Copy .Cells(1) 'allège la mémoire
        Application.EnableEvents = False 'désactive les évènements
        ActiveWorkbook.Close False 'ferme le fichier source
        Application.EnableEvents = True 'réactive les évènements
        .Visible = xlSheetVisible 'si la feuille est masquée
        Application.Goto .Cells(1), True 'cadrage
    End With
    fichier = Dir 'fichier suivant du dossier
Wend
End Sub

Tous les fichiers .xlsx dont le nom commence par PASA sont copiés.

A+

Bonjour job75

Merci je regarde

 

[onyirimba]

Bonjour job75,

Merci beaucoup la Macro fonctionne parfaitement