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

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é !!
 

job75

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

job75

XLDnaute Barbatruc
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
 

zendb

XLDnaute Junior
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 !
 

Discussions similaires

Statistiques des forums

Discussions
312 916
Messages
2 093 580
Membres
105 758
dernier inscrit
RIFAHI MOHAMED