XL 2013 Macro qui copie des données d'un fichier pour les coller dans un autre fichier selon des règles particulières

[onyirimba]

Bonjour,


Je souhaite copier les données des onglets du fichier " FTE VBA " dans l'onglet "Données" du fichier FTE FINALE VBA de la manière décrite ci-dessous et présenté dans la 2ième capture d'écran :

1. Fichier "FTE FINALE VBA" : la colonne F du mois => les 12 mois de l'année 2022 soient copiés pour chaque personne (01/01/2022, 02/02/2022... au 01/12/2022)
2. Fichier "FTE FINALE VBA" : Colonne C et colonne D => le nom et le prénom de chaque personne soit copié à 12 reprises (car 12 mois de l'année)
3. Fichier "FTE FINALE VBA" : la colonne B correspond à une formule => est-ce que la formule peut être copier à 12 reprises pour chaque personne
4. Fichier "FTE FINALE VBA" : la colonne A => est-ce que la cellule correspondante à chaque personne dans le fichier FTE VBA (colonne C) peut être copier à 12 reprises pour chaque personne ?
5. Est-ce que la programmation VBA peut tenir compte des 2 onglets F102 et F104 du fichier " FTE VBA " ?
6. Fichier "FTE FINALE VBA" : est-ce que les données peuvent être copiés les uns en dessous des autres par la Macro ?

Merci de votre aide.

fichier " FTE VBA "

Fichier FTE FINALE VBA

 

[Amiiram]

Salut
essaye ça :

 

[onyirimba]

Salut
essaye ça :

merci

Salut
essaye ça :

merci

 

[Amiiram]

j ai posé le code sur le fichier "FTE FINALE VBA"

 

[onyirimba]

j ai posé le code sur le fichier "FTE FINALE VBA"

merci

 

[Amiiram]

OK, en espérant que cela te convient

 

[job75]

Bonjour onyirimba,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Ouvrez "FTE FINALE VBA.xlsm" et voyez cette macro dans ThisWorkbook :

Private Sub Workbook_Activate()
Dim fichier$, F As Worksheet, lig&, w As Worksheet, nf$, dates, tablo, i&
fichier = ThisWorkbook.Path & "\FTE VBA.xlsm" 'à adapter
If Dir(fichier) = "" Then MsgBox "Fichier '" & fichier & "' introuvable !", 48: Exit Sub
Set F = Feuil1 'CodeName
lig = 2 '1ère ligne de destination
Application.ScreenUpdating = False
F.Rows(lig & ":" & F.Rows.Count).ClearContents 'RAZ
With Workbooks.Open(fichier)
    For Each w In .Worksheets
        nf = w.Name
        dates = Application.Transpose(w.Range("M11:X11"))
        tablo = w.Range("C11").CurrentRegion.Resize(, 3)
        For i = 2 To UBound(tablo)
            F.Cells(lig, 1).Resize(12) = tablo(i, 1)
            F.Cells(lig, 2).Resize(12) = nf
            F.Cells(lig, 3).Resize(12) = tablo(i, 2)
            F.Cells(lig, 4).Resize(12) = tablo(i, 3)
            F.Cells(lig, 6).Resize(12) = dates
            lig = lig + 12
    Next i, w
    Application.EnableEvents = False 'désactive l'évènement Open
    .Close False
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub

A+

 

[onyirimba]

Bonjour onyirimba,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Ouvrez "FTE FINALE VBA.xlsm" et voyez cette macro dans ThisWorkbook :

Private Sub Workbook_Activate()
Dim fichier$, F As Worksheet, lig&, w As Worksheet, nf$, dates, tablo, i&
fichier = ThisWorkbook.Path & "\FTE VBA.xlsm" 'à adapter
If Dir(fichier) = "" Then MsgBox "Fichier '" & fichier & "' introuvable !", 48: Exit Sub
Set F = Feuil1 'CodeName
lig = 2 '1ère ligne de destination
Application.ScreenUpdating = False
F.Rows(lig & ":" & F.Rows.Count).ClearContents 'RAZ
With Workbooks.Open(fichier)
    For Each w In .Worksheets
        nf = w.Name
        dates = Application.Transpose(w.Range("M11:X11"))
        tablo = w.Range("C11").CurrentRegion.Resize(, 3)
        For i = 2 To UBound(tablo)
            F.Cells(lig, 1).Resize(12) = tablo(i, 1)
            F.Cells(lig, 2).Resize(12) = nf
            F.Cells(lig, 3).Resize(12) = tablo(i, 2)
            F.Cells(lig, 4).Resize(12) = tablo(i, 3)
            F.Cells(lig, 6).Resize(12) = dates
            lig = lig + 12
    Next i, w
    Application.EnableEvents = False 'désactive l'évènement Open
    .Close False
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub

A+

Merci