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

onyirimba

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




- FICHIER SOURCE -
1648730915098.png
 

Pièces jointes

  • 1648727849580.png
    1648727849580.png
    94.8 KB · Affichages: 26
  • 1648727960082.png
    1648727960082.png
    76.7 KB · Affichages: 22
  • VBAChargement_BUD_00 R-O.xlsm
    44.2 KB · Affichages: 3
  • VBAChargement_BUD_00_2200 2STOC.xlsm
    44.7 KB · Affichages: 5
  • VBASuivi Var.xlsm
    12.4 KB · Affichages: 5
Dernière édition:
Solution
Bonjour Onyirimba, bonjour le forum,

Le problème est que tu ne nous dis pas 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 :

VB:
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...

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Onyirimba, bonjour le forum,

Le problème est que tu ne nous dis pas 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 :

VB:
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

XLDnaute Occasionnel
Supporter XLD
Bonjour Onyirimba, bonjour le forum,

Le problème est que tu ne nous dis pas 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 :

VB:
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

XLDnaute Occasionnel
Supporter XLD
Bonjour Onyirimba, bonjour le forum,

Le problème est que tu ne nous dis pas 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 :

VB:
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
 

Discussions similaires