Sujet Précédent Sujet Suivant

Macro qui copie et colle des données selon des conditions

Résolu/Fermé
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 - Modifié le 1 avril 2022 à 11:31
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 - 4 avril 2022 à 10:17
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

J'ai joint 3 fichiers illustratifs :
Le lien a été crée : https://www.cjoint.com/c/LDbjuhxtndO
Le lien a été crée : https://www.cjoint.com/c/LDbjvuiJqtO
Le lien a été crée : https://www.cjoint.com/c/LDbjxQFp26O
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 -




Configuration: Windows / Chrome 100.0.4896.60
A voir également:

2 réponses

Réponse 1 / 2
yg_be Messages postés 23436 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 janvier 2025 Ambassadeur 1 559
1 avril 2022 à 11:54
bonjour,
"il ne fonctionne pas": quel est le symptôme?
1
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 2
1 avril 2022 à 12:00
bonjour,

je n'arrive pas à trouver le bon codage pour réaliser mon projet
0
yg_be Messages postés 23436 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 janvier 2025 1 559 > Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022
1 avril 2022 à 15:01
je suggère ceci: 
Option Explicit

Sub budget()
Dim csrc As Workbook, fsrc As Worksheet, fdest As Worksheet, rsrc As Range, rdest As Range

Set fdest = ThisWorkbook.Sheets("Budget")
Set rdest = fdest.[a4].End(xlDown).Offset(1)
For Each csrc In Workbooks
    If csrc.Name Like "*Chargement*.xlsm" Then
        Set fsrc = csrc.Sheets("Coûts")
        Set rsrc = fsrc.[A11]
        Do While rsrc <> ""
            rdest = rsrc
            rdest.Offset(, 3) = rsrc.Offset(, 1)
            Set rsrc = rsrc.Offset(1)
            Set rdest = rdest.Offset(1)
        Loop
    End If
Next csrc
End Sub
1
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 2 > yg_be Messages postés 23436 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 janvier 2025
Modifié le 1 avril 2022 à 17:20
Merci cela fonctionne parfaitement

J'ai essayé le codage ci-après pour fermer à la fin de la macro les fichiers qui débutent par "Chargement" mais cela ne fonctionne pas
est-ce que tu peux m'aider ?
merci

For Each x In Workbooks
If x.Name Like "*Chargement*.xlsm" Then

Workbooks("*Chargement*.xlsm").Close savechanges:=False
End If
Next x
0
yg_be Messages postés 23436 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 janvier 2025 1 559 > Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022
1 avril 2022 à 17:42
"cela ne fonctionne pas": qu'observes-tu?

moi j'essaierais plutôt: 
x.Close savechanges:=False
1
Réponse 2 / 2
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 2
4 avril 2022 à 10:17
Bonjour yg_be,

La Macro fonctionne parfaitement
Merci
0

Discussions similaires

Reporter valeur sur autre feuille avec critere
Otk168 -
via55 -

4 réponses
copie de texte
jean -
jean -

5 réponses