Macro: Fichier de Synthese, help !!

Option Explicit

Sub Synthese()
Dim vChemin As String
Dim vClasseur() As String
Dim nb As Integer, i As Integer
Dim oWb1 As Workbook, oWbW As Workbook
Dim oWs1 As Worksheet, oWsS As Worksheet
Dim vLine As Long

    vChemin = ThisWorkbook.Path & "\MonDossier" 'remplacer par le chemin vers le dossier contenant les classeurs, ex : vChemin = "C:\Documents and Settings\Nom\Excel\forum"
    
    nb = 1
    ReDim vClasseur(1 To nb)
    vClasseur(1) = Dir(vChemin & "\" & "*.xls*")
    If vClasseur(1) = "" Then Exit Sub
    
    Do While vClasseur(nb) <> ""
        nb = nb + 1
        ReDim Preserve vClasseur(1 To nb)
        vClasseur(nb) = Dir
    Loop
    
    nb = nb - 1
    ReDim Preserve vClasseur(1 To nb)
    Set oWb1 = ThisWorkbook
    Set oWs1 = ThisWorkbook.Worksheets("Synth") 'remplacer par le nom de la feuille recevant les données
    vLine = oWs1.Cells(Rows.Count, 2).End(xlUp).Row + 1 'remplacer 2 par le n° d'une colonne non vide du tableau qui recoit les données
    
    For i = 1 To nb
        Workbooks.Open vChemin & "\" & vClasseur(i)
        Set oWbW = Workbooks(vClasseur(i))
        Set oWsS = oWbW.Worksheets("Projet_Eur") 'remplacer par le nom de l'onglet commun
        'bloc à adapter selon les cellules à chercher
        oWs1.Cells(vLine, 1) = oWsS.Cells(6, 7) 'copie G6 en colonne 1
        oWs1.Cells(vLine, 2) = oWsS.Cells(7, 7) 'copie G7 en colonne 2
        oWs1.Cells(vLine, 3) = oWsS.Cells(6, 10) 'copie J6 en colonne 3
        oWs1.Cells(vLine, 4) = oWsS.Cells(8, 10) 'copie J8 en colonne 4
        Set oWsS = Nothing
        oWbW.Close
        Set oWbW = Nothing
        vLine = vLine + 1
    Next i
    
End Sub