And this is the code i need inserted at the right places which is indicated with comments as to where things go..


Sub dataTransfer()

Dim wkbData As Workbook
Dim cell As Range
Dim Fichiers() As String, nomFichier As String, myPath As String, myFile As String
Dim i As Integer, NBFichier As Integer
Dim wks As Worksheet
Dim rngTarget As Range, rngCell As Range
Dim lngLastRow As Long

myPath = "C:\conv\Analyze\"
myFile = Dir(myPath & "*.xls")
i = 0
Do While myFile <> ""
ReDim Preserve Fichiers(i)
Fichiers(i) = myFile
i = i + 1
myFile = Dir
Loop
NBFichier = UBound(Fichiers) + 1
'nomFichier = Cells(2, 1)

'
' Creates a path to open the DataEchantillon File
'
myPath2 = "D:\Documents and Settings\pw41203\Desktop\Eric\Excel_Program\DataEchantillon.xls"
'
' Ouvre le fichier DataEchantillon
'
Workbooks.Open Filename:=myPath2
Lignetravail = 2
'

Workbooks.Open Filename:=myPath & Fichiers(i), ReadOnly:=True
nomFichier = Cells(2, 1)
'
' Trouver le nombre de composantes
'
NbComposes = 1

Do While Cells(1, NbComposes + 2) <> ""
NbComposes = NbComposes + 1
Loop
For j = 1 To Nbcompose
NomCompose = Cells(1, j + 1)
UniteCompose = Cells(2, j + 1)
Next j


Stop

' Transfers date values from all open Analysis to the file "DataEchantillon.xls"


Set rngTarget = Workbooks("DataEchantillon.xls").Worksheets(1).Cells(3, "B")
For i = LBound(Fichiers) To UBound(Fichiers)
Set wkbData = Workbooks.Open(Filename:=myPath & Fichiers(i), ReadOnly:=True)
' Check sheet exists
Set wks = wkbData.Worksheets(1)
lngLastRow = wks.Range("A65536").End(xlUp).Row
' make sure there is data in row 3 or below
If lngLastRow > 2 Then
For Each rngCell In wks.Range(wks.Range("A3"), wks.Cells(lngLastRow, "A"))
If Len(Trim$(rngCell.Value)) > 0 Then
Union(rngTarget, rngTarget.Offset(0, 5)).Value = rngCell.Value
Set rngTarget = rngTarget.Offset(1, 0)
End If
Next rngCell
End If
wkbData.Close False
Next i
'rngTarget.Parent.Parent.Close True


' Transfers data values from Analysis to the file "DataEchantillon.xls"

Set rngTarget = Workbooks("DataEchantillon.xls").Worksheets(1).Cells(3, "AG")
For i = LBound(Fichiers) To UBound(Fichiers)
Set wkbData = Workbooks.Open(Filename:=myPath & Fichiers(i), ReadOnly:=True)
' Check sheet exists
Set wks = wkbData.Worksheets(1)
lngLastRow = wks.Range("B65536").End(xlUp).Row
' make sure there is data in row 3 or below
If lngLastRow > 2 Then
For Each rngCell In wks.Range(wks.Range("B3:E3"), wks.Cells(lngLastRow, "AG"))
If Len(Trim$(rngCell.Value)) > 0 Then
Union(rngTarget, rngTarget).Value = rngCell.Value
Set rngTarget = rngTarget.Offset(1, 0)
End If
Next rngCell
End If
wkbData.Close False
Next i
'rngTarget.Parent.Parent.Close True
End Sub