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

XLDnaute Occasionnel
Supporter XLD
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 "
1635928296204.png



Fichier FTE FINALE VBA
1635928305521.png
 

Pièces jointes

  • FTE FINALE VBA.xlsm
    10.4 KB · Affichages: 4
  • FTE VBA.xlsm
    14 KB · Affichages: 3

job75

XLDnaute Barbatruc
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 :
Code:
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+
 

Pièces jointes

  • FTE FINALE VBA(1).xlsm
    20.7 KB · Affichages: 5
  • FTE VBA.xlsm
    14 KB · Affichages: 9

onyirimba

XLDnaute Occasionnel
Supporter XLD
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 :
Code:
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
 

Discussions similaires

Statistiques des forums

Discussions
311 734
Messages
2 082 020
Membres
101 872
dernier inscrit
Colin T