Macro copie de données d'un fichier à l'autre

Sandrine123

XLDnaute Nouveau
Bonjour,

J'aimerais de l'aide concernant une macro.

J'ai 2 fichiers : ORIGINE.xls et DESTINATION.xls

J'aimerais que lorsque je lance la macro, une fenetre s'ouvre et me permettre de sélectionner le fichier de destination.

Dans le fichier ORIGINE, les données sont en ligne et dans le fichier DESTINATION les données sont en colonne.

Le but de la macro serait de copier ces lignes et de les mettre dans les colonnes du fichier destination.

Il faut que la macro vérifie le code à trois lettres en colonne D du fichier ORIGINE, et copie les données correspondantes à ce code dans le fichier DESTINATION.

Par exemple la cellule E5 du fichier ORIGINE doit être copié dans la cellule F5 du fichier DESTINATION.
la cellule F5 doit être copié dans la cellule F6 du fichier DESTINATION.

Pour faire un autre exemple, la cellule E6 doit etre copié dans la cellule L5 du fichier destination.

Merci d'avance de votre aide.
 

Pièces jointes

  • ORIGINE.xls
    25.5 KB · Affichages: 23
  • DESTINATION.xls
    34.5 KB · Affichages: 25
  • ORIGINE.xls
    25.5 KB · Affichages: 22
  • DESTINATION.xls
    34.5 KB · Affichages: 25
  • ORIGINE.xls
    25.5 KB · Affichages: 24
  • DESTINATION.xls
    34.5 KB · Affichages: 25

job75

XLDnaute Barbatruc
Re : Macro copie de données d'un fichier à l'autre

Bonjour Sandrine123,

Voyez les fichiers joints et cette macro dans le 1er :

Code:
Sub Transfert()
Dim r As Range, c As Range
ChDir ThisWorkbook.Path 'chemin à adapter
Set r = Range("D3", Range("D" & Rows.Count).End(xlUp))
If r.Row < 3 Then Exit Sub
On Error Resume Next
Application.Dialogs(xlDialogOpen).Show
On Error GoTo 0
If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
Application.ScreenUpdating = False
For Each r In r
  If r <> "" Then
    Set c = Cells.Find(r, , xlValues, xlWhole)
    If Not c Is Nothing Then
      c(1, 4).Resize(12) = Application.Transpose(r(1, 2).Resize(, 12))
    End If
  End If
Next
End Sub
A+
 

Pièces jointes

  • ORIGINE(1).xls
    51.5 KB · Affichages: 30
  • DESTINATION.xls
    37.5 KB · Affichages: 30
  • ORIGINE(1).xls
    51.5 KB · Affichages: 27
  • DESTINATION.xls
    37.5 KB · Affichages: 28
  • ORIGINE(1).xls
    51.5 KB · Affichages: 32
  • DESTINATION.xls
    37.5 KB · Affichages: 33

job75

XLDnaute Barbatruc
Re : Macro copie de données d'un fichier à l'autre

Re,

Notez que pour afficher uniquement les fichiers avec le mot "DESTINATION" on écrira :

Code:
Application.Dialogs(xlDialogOpen).Show "*DESTINATION*"
A+
 

Discussions similaires

Réponses
11
Affichages
246

Statistiques des forums

Discussions
312 500
Messages
2 089 005
Membres
104 003
dernier inscrit
adyady__