XL 2013 VBA qui copie et colle dans un autre fichier des données selon différentes conditions

[onyirimba]

Bonjour,

J'ai programmé une Macro qui copie les données de fichiers qui dont l'intitulé débute par "VBAChargement_BUD..." (fichier source) pour les coller dans l'onglet "Budget" du fichier "VBASuivi Var" (fichier de destination) selon des conditions :

1. Dans le fichier VBASuivi Var les données doivent être collés à partir de la colonne C et partir de la ligne 5 en dessous des informations existantes
2. que la Macro copie les données de tous les fichiers qui commencent par "VBAChargement_BUD..." (car il peut y avoir 5 ou 6 fichiers dont l'intitulé débute par "VBAChargement_BUD...")
3. les données à copier dans les fichiers (voir la 2ieme capture d'écran : Fichier Source) qui débutent par "VBAChargement_BUD..." doivent l'être de la rangée "A11 à J11" (ligne 11) jusqu'à ce qu'il n'ai plus de données à copier (dans le cas de la pièce jointe c'est ligne 12 mais cela peut être ligne 16 si il y a des données présentes jusqu'à la ligne 16)

J'ai essayé le codage ci-après mais il ne fonctionne pas.
Est-ce que vous pouvez m'aider ?

Merci d'avance

Sub budget()
Dim x

For Each x In Workbooks
If x.Name Like "Chargement_BUD*.xlsm" Then
Range("A10").Select
Application.CutCopyMode = False
Selection.Copy
Range("J1").Select
ActiveSheet.Paste

End If
Next x



End Sub


- FICHIER DE DESTINATION -

- FICHIER SOURCE -

 

[Robert]

Bonjour Onyirimba, bonjour le forum,

Le problème est que tu ne nous dis pas où se trouvent les fichiers !...
Le code ci-dessous, à placer dans le fichier VBASuivi Var.xlsm, fonctionnera si :
1. Les fichiers se trouvent tous dans le même dossier que VBASuivi Var.xlsm
2. La ligne 9 de tous les fichiers source est vide
3. L'onglet des données à copier de tous les fichier source s'appelle Coûts
Sinon, il faudra adapter mais il faudra aussi que tu nous donnes renseignements manquants...
Le code :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets("Budget") 'définit l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "VBAChargement_BUD*") 'définit le premier fichier F ayant CA comme chemin d'accès et commençant par "VBAChargement_BUD"
Do While F <> "" 'exécute tant qu'il existe un fichier F
    Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS en l'ouvrant
    Set OS = CS.Worksheets("Coûts") 'définit l'onglet source OS / peut aussi être : Set OS = CS.Worksheets(1)
    Set PL = OS.Range("A10").CurrentRegion 'définit la plage PL
    Set PL = PL.Offset(1, 0).Resize(PL.Rows.Count - 1, PL.Columns.Count) 'redéfinit la plage PL sans la première ligne
    Set DEST = OD.Cells(Application.Rows.Count, "C").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    PL.Copy DEST 'copie la plage PL et la colle dans DEST
    CS.Close False 'ferme le classeur source sans enregistrer
    F = Dir 'définit le prochain fichier F ayant CA comme chemin d'accès et commençant par "VBAChargement_BUD"
Loop 'boucle
Application.ScreenUpdating = True 'affiche les rafraîchiessements d'écran
End Sub

 

[onyirimba]

Bonjour Onyirimba, bonjour le forum,

Le problème est que tu ne nous dis pas où se trouvent les fichiers !...
Le code ci-dessous, à placer dans le fichier VBASuivi Var.xlsm, fonctionnera si :
1. Les fichiers se trouvent tous dans le même dossier que VBASuivi Var.xlsm
2. La ligne 9 de tous les fichiers source est vide
3. L'onglet des données à copier de tous les fichier source s'appelle Coûts
Sinon, il faudra adapter mais il faudra aussi que tu nous donnes renseignements manquants...
Le code :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets("Budget") 'définit l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "VBAChargement_BUD*") 'définit le premier fichier F ayant CA comme chemin d'accès et commençant par "VBAChargement_BUD"
Do While F <> "" 'exécute tant qu'il existe un fichier F
    Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS en l'ouvrant
    Set OS = CS.Worksheets("Coûts") 'définit l'onglet source OS / peut aussi être : Set OS = CS.Worksheets(1)
    Set PL = OS.Range("A10").CurrentRegion 'définit la plage PL
    Set PL = PL.Offset(1, 0).Resize(PL.Rows.Count - 1, PL.Columns.Count) 'redéfinit la plage PL sans la première ligne
    Set DEST = OD.Cells(Application.Rows.Count, "C").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    PL.Copy DEST 'copie la plage PL et la colle dans DEST
    CS.Close False 'ferme le classeur source sans enregistrer
    F = Dir 'définit le prochain fichier F ayant CA comme chemin d'accès et commençant par "VBAChargement_BUD"
Loop 'boucle
Application.ScreenUpdating = True 'affiche les rafraîchiessements d'écran
End Sub

bonjour Robert, bonjour Forum

merci la Macro fonctionne

 

[onyirimba]

Bonjour Onyirimba, bonjour le forum,

Le problème est que tu ne nous dis pas où se trouvent les fichiers !...
Le code ci-dessous, à placer dans le fichier VBASuivi Var.xlsm, fonctionnera si :
1. Les fichiers se trouvent tous dans le même dossier que VBASuivi Var.xlsm
2. La ligne 9 de tous les fichiers source est vide
3. L'onglet des données à copier de tous les fichier source s'appelle Coûts
Sinon, il faudra adapter mais il faudra aussi que tu nous donnes renseignements manquants...
Le code :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets("Budget") 'définit l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "VBAChargement_BUD*") 'définit le premier fichier F ayant CA comme chemin d'accès et commençant par "VBAChargement_BUD"
Do While F <> "" 'exécute tant qu'il existe un fichier F
    Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS en l'ouvrant
    Set OS = CS.Worksheets("Coûts") 'définit l'onglet source OS / peut aussi être : Set OS = CS.Worksheets(1)
    Set PL = OS.Range("A10").CurrentRegion 'définit la plage PL
    Set PL = PL.Offset(1, 0).Resize(PL.Rows.Count - 1, PL.Columns.Count) 'redéfinit la plage PL sans la première ligne
    Set DEST = OD.Cells(Application.Rows.Count, "C").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    PL.Copy DEST 'copie la plage PL et la colle dans DEST
    CS.Close False 'ferme le classeur source sans enregistrer
    F = Dir 'définit le prochain fichier F ayant CA comme chemin d'accès et commençant par "VBAChargement_BUD"
Loop 'boucle
Application.ScreenUpdating = True 'affiche les rafraîchiessements d'écran
End Sub

encore merci