Sub A_Transfert_Données_Feuille_vers_BD()
'MJ
'sélectionner le nom des champs à transférer puis cliquer aussi
'sur le fichier qui a les données à transférer
Dim Sht As Worksheet
Dim listeNF(2)
n = 1
For Each Sht In ActiveWindow.SelectedSheets
listeNF(n) = Sht.Name: n = n + 1
Next Sht
Typesh1 = InputBox(listeNF(1) & " position (Receveur/Donneur)")
Typesh2 = InputBox(listeNF(2) & " position (Receveur/Donneur)")
'Typesh1 = "D"
'Typesh2 = "R"
If Typesh1 = "D" Then NFD = listeNF(1) Else NFD = listeNF(2)
If Typesh2 = "R" Then NFR = listeNF(2) Else NFR = listeNF(1)
'MsgBox ("R " & NFR)
'MsgBox ("D " & NFD)
Sheets(NFR).Activate
Sheets(NFR).Select
ActiveWorkbook.Names.Add Name:="ZoneATransf", RefersToR1C1:=Selection
Sheets(NFD).Select
For Each cel In Sheets(NFR).Range("ZoneATransf")
Sheets(NFD).Activate
Cells(1, 1).Select
'adrcel = Cells.Find(cel).Address
'MsgBox adrcel
Cells.Find(cel).Select
Stop
derl = Cells(65536, ActiveCell.Column).End(xlUp).Rows.Row
Range(Cells(2, ActiveCell.Column), Cells(derl, ActiveCell.Column)).Select
Selection.Copy
Sheets(NFR).Activate
Cells.Find(cel).Select
derl = Cells(65536, ActiveCell.Column).End(xlUp).Rows.Row
Cells(derl + 1, ActiveCell.Column).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next
End Sub