Copier valeur dans un autre fichier

Bonjour,

J'ai besoin de vos lumières car je n'y vois plus bien clair.

Je ne peux pas vous mettre le fichier car il est gros avec pleins de données confidentielles.

J'ai une fichier (SUIVI PARCS) sur lequel j'ouvre un userform, dans cet userform je souhaiterais avoir un bouton (TRAITEMENT) sur lequel quand je clique dessus, il me demande quel fichier je souhaite intégrer à la feuille choisie dans un listbox(Listbox3.value).
Le fichier à choisir est un fichier excel enregistrer sur le disque dur, ce fichier est nettoyé des valeurs dont je n'ai pas besoin mais il a une colonne REFERENCE avec un nombre de ligne variable et la valeur de la REFERENCE correspond à des cellules précises (F8 à K8) de la feuille choisie (Listbox3.value).

Je souhaiterais suivant la reference du fichier ouvert, coller les valeurs dans une colonne précise (colonne O a T) suivant la référence : F8 = colonne O, G8 = colonne P, ...

J'espere avoir été assez clair, si ce n'est pas le cas, n'hésitez pas.

Mon code fonctionne uniquement pour la 1ere colonne et je en vois pas comment mettre les données en automatique dans les autres colonnes.

Si vous pouviez m'aider, ça serait génial

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'INTEGRER DONNEES AUTOMATIQUEMENT

Private Sub TRAITEMENTS_Click()
Dim j, i
Dim TRAITEMENT

'************************
'ouverture et choix du fichier
TRAITEMENT = Application.GetOpenFilename("Fichiers Microsoft Office Excel,*.xls;*.xlt;*.xla")

'************************
'verifier si le fihcier est deja ouvert et le fermer



'sinon ouvrir le fichier
If TRAITEMENT <> False Then
Application.ScreenUpdating = False
Workbooks.Open TRAITEMENT


With ActiveWorkbook.Sheets(1)

'format du fichier ouvert
.Cells(3, 1).Copy .Cells(13, 20)
.Range("A1:A11").EntireRow.Delete
.Columns("A:A").Delete Shift:=xlToLeft
.Columns("E:F").Delete Shift:=xlToLeft
.Columns("K:P").Delete Shift:=xlToLeft

.Cells(1, 1) = "ID"
.Cells(1, 2) = "DATE"
.Cells(1, 3) = "QTE"
.Cells(1, 4) = "REF"
.Cells(1, 5) = "NOM"
.Cells(1, 6) = "PRENOM"
.Cells(1, 7) = "ADRESSE1"
.Cells(1, 8) = "ADRESSE2"
.Cells(1, 9) = "CP"
.Cells(1, 10) = "VILLE"
.Cells(1, 11) = "PARC"

'copier les informations

j = ThisWorkbook.Sheets(ListBox3.Value).Cells(65000, 12).End(xlUp).Row + 1
For i = 2 To .[a65000].End(xlUp).Row

ThisWorkbook.Sheets(ListBox3.Value).Range("L" & j).Value = .Range("B" & i).Value
ThisWorkbook.Sheets(ListBox3.Value).Range("M" & j).Value = .Range("A" & i).Value
ThisWorkbook.Sheets(ListBox3.Value).Range("N" & j).Value = .Range("E" & i).Value

'C'EST ICI QUE JE TROUVE PAS LA SOLUTION, CA ME COPIE BIEN DANS LA 1ERE COLONNE MAIS CA NE FONTIONNE PAS DANS LES AUTRES :
If .Range("D" & i).Value = ThisWorkbook.Sheets(ListBox3.Value).Range("F8") Then
ThisWorkbook.Sheets(ListBox3.Value).Range("O" & j).Value = .Range("C" & i).Value
ElseIf .Range("D" & i).Value = ThisWorkbook.Sheets(ListBox3.Value).Range("G8") Then
ThisWorkbook.Sheets(ListBox3.Value).Range("P" & j).Value = .Range("C" & i).Value
ElseIf .Range("D" & i).Value = ThisWorkbook.Sheets(ListBox3.Value).Range("H8") Then
ThisWorkbook.Sheets(ListBox3.Value).Range("Q" & j).Value = .Range("C" & i).Value
ElseIf .Range("D" & i).Value = ThisWorkbook.Sheets(ListBox3.Value).Range("I8") Then
ThisWorkbook.Sheets(ListBox3.Value).Range("R" & j).Value = .Range("C" & i).Value
ElseIf .Range("D" & i).Value = ThisWorkbook.Sheets(ListBox3.Value).Range("J8") Then
ThisWorkbook.Sheets(ListBox3.Value).Range("S" & j).Value = .Range("C" & i).Value
ElseIf .Range("D" & i).Value = ThisWorkbook.Sheets(ListBox3.Value).Range("K8") Then
ThisWorkbook.Sheets(ListBox3.Value).Range("T" & j).Value = .Range("C" & i).Value
End If

j = j + 1

Next i

End With

'fermer le fichier ouvert sans sauvegarder
ActiveWorkbook.Close False

End If

End sub
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Si vous pouviez m'éclairer un peu, ça m'enlèverais une grosse épine du pied car je l'ai retourné dans tous les sens ce code mais je ne vois comment y arriver.

Dans l'attente de vos retours.

Je vous remercie tous d'avance.