XL 2016 Macro pour copier plusieurs cellules vers un fichier :(

  • Initiateur de la discussion Initiateur de la discussion zendb
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

zendb

XLDnaute Junior
Bonjour,

Avant toute chose j'ai essayé de m'en sortir seul mais je n'ai pas réussi car je débute +++

J'ai un fichier "source" qui s'appelle formulaire
J'aimerai pouvoir copier les données d'un fichier présent dans 4 cellules vers 4 cellules spécifiques de ce fichier formulaire.

La cellule B1 du fichier "fichier xxx" vers la cellule D9 du fichier formulaire

Au début je voulais créer une macro, exécutée à partir du fichier "Formulaire" pour "aller chercher" les données. Mon soucis est que j'ai énormement de fichiers sources donc je ne peux définir son nom, ni son emplacement.

Deuxième idée : ouvrir les 2 fichiers, exécuter une macro pour "envoyer" vers le fichier Formulaire.

J'ai réussi à construire quelque chose de basique qui fonctionne :
VB:
Range("B1").Select
Selection.Copy
Workbooks("Formulaire.xlsm").Activate
ActiveSheet.Range("D9").Select
ActiveSheet.Paste

J'ai deux soucis ...

1er problème :
- je souhaite faire une copie sans mise en forme, pour conserver la mise en forme du fichier de destination.
J'ai eu beau essayer cela, mais j'ai un message d'erreur :

VB:
Range("B1").Select
Selection.Copy
Workbooks("Formulaire.xlsm").Activate
ActiveSheet.Range("D9").Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues


2e problème :
Etant donné que je veux copier 4 cellules, je me suis dit que j'allais les mettre à la suite :
VB:
Range("B1").Select
Selection.Copy
Workbooks("Formulaire.xlsm").Activate
ActiveSheet.Range("D9").Select
ActiveSheet.Paste


Range("D1").Select
Selection.Copy
Workbooks("Formulaire.xlsm").Activate
ActiveSheet.Range("D7").Select
ActiveSheet.Paste


Range("D2").Select
Selection.Copy
Workbooks("Formulaire.xlsm").Activate
ActiveSheet.Range("D11").Select
ActiveSheet.Paste


Range("B2").Select
Selection.Copy
Workbooks("Formulaire.xlsm").Activate
ActiveSheet.Range("D13").Select
ActiveSheet.Paste

Mais vous le devinez rapidement, hô malheur, ma feuille active reste le fichier "Formulaire" et au lieu de faire un transfert il me copie les cellules dans le même fichier.
Après 2h pour écrire 4 lignes qui ne fonctionnent pas ... je me suis dit que j'allais vous demander de l'aide !!

Mais bon, j'ai quand même essayé !!
 
Bonjour zendb,

En VBA les Select et autre Activate sont à éviter, utilisez :
VB:
Workbooks("Formulaire.xlsm").Sheets(1).Range("D9") = ThisWorkbook.Sheets(1).Range("B1")
Workbooks("Formulaire.xlsm").Sheets(1).Range("D7") = ThisWorkbook.Sheets(1).Range("D1")
Workbooks("Formulaire.xlsm").Sheets(1).Range("D11") = ThisWorkbook.Sheets(1).Range("D2")
Workbooks("Formulaire.xlsm").Sheets(1).Range("D13") = ThisWorkbook.Sheets(1).Range("B2")
A+
 
S'il y a beaucoup de cellules à copier on utilisera une boucle pour alléger le code, comme ceci :
VB:
Dim source, dest, n
source = Split("B1 D1 D2 B2")
dest = Split("D9 D7 D11 D13")
For n = 0 To UBound(dest)
    Workbooks("Formulaire.xlsm").Sheets(1).Range(dest(n)) = ThisWorkbook.Sheets(1).Range(source(n))
Next n
 
Super merci !

J'ai testé et ça fonctionne après avoir modifié le nom des onglets.
Et je viens de comprendre son fonctionnement.

Par contre, la macro doit être enregistré dans le fichier source ? pas celui de destination ?

"ThisWorkbook" fait référence au fichier dans lequel est enregistré la macro ? pas le fichier dans lequel je la lance ?

Mon problème est que j'ai 500 fichiers sources, qui ne contiennent pas cette macro. Je voulais créer la macro à partir du fichier de destination "Formulaire.xlsm" puis la lancer à partir du fichier source.
Il ne faut pas repenser.

Bon, j'ai remplacé "ThisWorkbook" par "ActiveWorkbook" et ça fonctionne à merveille !
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
1
Affichages
498
Réponses
1
Affichages
407
Retour