Transfert de données vba

Bonjour à tous,

Actuellement j'ai créé 2 documents Excel avec chacun des programmes vba.
Le 1er (MC_fonctionne) me permet, par un userform, de récolter des informations.
Le 2nd (MC_JCB_test) doit être capable d'aller chercher les infos rentrées dans le 1er document.

C'est à dire, j'ouvre mon document nommé "MC_JCB_test". Dans l'onglet "Menu" je clique sur le bouton "Extraction hebdomadaire" et à ce moment là, une boîte de dialogue me demande le numéro de semaine souhaité.
Puis, mon programme recherche toutes les infos rentrées dans "MC_fonctionne" correspondant à cette semaine.
Une fois qu'il a trouvé toutes les infos, il me les écrit dans l'onglet "Synthese".

Le problème que je rencontre c'est qu'il n'arrive pas à lire les infos de "MC_fonctionne" et m'affiche un message d'erreur :"Erreur définie par l'application ou par l'objet"

Voici le programme qui me pose soucis (ligne en rouge ou le message apparait):


Option Explicit
Option Base 1

Sub Extraction_Hebdo()
Dim tblo, tblo1, xchoixnosem As Long
Dim i As Long, j As Long, xdlgn As Long, xlgn As Long
Dim Date_sel As Date
Dim Semaine As Integer
Application.ScreenUpdating = False

' Contrôle de la saisie
'ATTENTION LE BOUTON DE COMMANDE ANNULER DE INPUTBOX GENERE UNE ERREUR

Semaine = DatePart("ww", Date, vbMonday)
Semaine = InputBox("Semaine à selectionner ?", "Semaine", Semaine - 1)
If Semaine < 1 Or Semaine > 52 Then
MsgBox "Le numéro de la semaine doit être un chiffre compris entre 1 et 52.", vbCritical, "Choix de la semaine"
Application.ScreenUpdating = True
End If

' Extraction des données
With Workbooks("MC_fonctionne.xlsm").Sheets("Synthese")
.Activate

' Transfert des données de la feuille dans un array
tblo = .Range("A6:N" & xdlgn).Value
' Tri des données
' Code non réalisé
End With

' Copy tblo dans tblo1
ReDim tblo1(LBound(tblo, 1) To UBound(tblo, 1), LBound(tblo, 2) To UBound(tblo, 2))
xlgn = 0
For i = LBound(tblo, 1) To UBound(tblo, 1)
For j = LBound(tblo, 2) To UBound(tblo, 2)
If tblo(i, 14) = xchoixnosem Then
tblo1(i, j) = tblo(i, j)
xlgn = xlgn + 1
End If
Next j
Next i

' Test si donnees trouvees
If xlgn = 0 Then
With Workbooks("MC_JCB_test.xlsm").Sheets("Synthese")
.Activate
xdlgn = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A2:N" & xdlgn).ClearContents
End With
With Workbooks("MC_JCB_test.xlsm").Sheets("Menu")
.Activate
Application.ScreenUpdating = True
.Range("A1").Select
End With
MsgBox "Aucun résultat pour la semaine no. " & xchoixnosem
Exit Sub
End If

' Transfert des données de tblo1 dans la feuille - Code à améliorer suppression des lignes vides dans le tableau
With Workbooks("MC_JCB_test.xlsm").Sheets("Synthese")
.Activate
xdlgn = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A2:N" & xdlgn).ClearContents
.Range("A2").Resize(UBound(tblo1, 1), UBound(tblo1, 2)).Value = tblo1
' supprime les lignes vides
xdlgn = .Range("A" & Rows.Count).End(xlUp).Row
For i = xdlgn To 2 Step -1
If .Cells(i, 1) = "" Then
.Rows(i).Delete
End If
Next i
.Range("A1").Select
Application.ScreenUpdating = True
End With
Erase tblo: Erase tblo1
End Sub

Merci, par avance, pour votre aide