L'indice n'appartient pas à la sélection

Bonjour,

lorsque je lance la macro, j'ai un message l'indice n'appartient pas à la sélection à cet endroit

Le code doit demander le répertoire dans lequel je dois lister l'ensemble des fichiers de dossiers puis recopier le résultat en A1.

Sub ChoixRepertoire()
Dim chemin As String
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim J As Long
Dim LeChemin As String
Dim Data()
Dim NBdata As Long

 Set objShell = CreateObject("Shell.Application")
 Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)

 Set oFolderItem = objFolder.Items.Item
 chemin = oFolderItem.Path
 Sheets("Liste Fichiers").Range("G1").Value = chemin

 Application.ScreenUpdating = False
  LeChemin = Cells(1, 7)
  LireRepertoir LeChemin, True

  With Sheets("Liste Fichiers")
    .Range("A1").Resize(UBound(Data, 2), 3) = Application.Transpose(Data)
  End With

End Sub
'Obtenir tous les fichiers d'un répertoire et éventuellement des sous-répertoires
'Si SousRep = true
'Le répertoire source doit être dans Rep
Public Function LireRepertoir(ByVal Rep As String, Optional SousRep As Boolean) As Integer
Dim Obj, RepP, F, S, sf, F1, Fsous
Dim i As Integer, Ext As String
Dim Chem As String
Dim T As Double
Dim Data()
Dim NBdata As Long

  NBdata = 1
  ReDim Data(1 To 4, 1 To NBdata)
    Set Obj = CreateObject("Scripting.FileSystemObject")
    Set RepP = Obj.Getfolder(Rep)
    Chem = Rep: If Right(Chem, 1) <> "\" Then Chem = Chem & "\"

    Set sf = RepP.subfolders
    Set F = RepP.Files
    GoSub RempliData                        'les fichiers du répertoire principal
    If SousRep Then                         'les fichiers des sous-répertoires
        For Each Fsous In sf
            Set RepP = Fsous
            Set F = RepP.Files
            GoSub RempliData
        Next Fsous
    End If
Exit Function
'**********************************************************************
RempliData:
  For Each F1 In F
    NBdata = NBdata + 1
    ReDim Preserve Data(1 To 4, 1 To NBdata)
    Data(1, NBdata) = F1.ParentFolder & "\" & F1.Name
    Next F1

Return

End Function

Merci pour vos réponses et bonne journée

Voici le bon code

Option Explicit
Dim Data()
Dim NBdata As Long
Sub FichiersdansNdossiers()
Dim chemin As String
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim J As Long
Dim LeChemin As String
Dim extension As String
Set objShell = CreateObject("Shell.Application")
 Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 Set oFolderItem = objFolder.Items.Item

 extension = InputBox("Indiquez l'extension désirée.", "Extension", "Tous fichiers")
If extension = "Tous fichiers" Then
        extension = "*"
End If
With Range("A:A")
        .ClearContents
        .Interior.ColorIndex = xlNone
End With

 chemin = oFolderItem.Path
 Sheets("Liste Fichiers").Range("G1").Value = chemin

 Application.ScreenUpdating = False
  LeChemin = Cells(1, 7)
  LireRepertoir LeChemin, True
  With Sheets("Liste Fichiers")
    .Range("A1").Resize(UBound(Data, 2), 3) = Application.Transpose(Data)
  End With

End Sub
'Obtenir tous les fichiers d'un répertoire et éventuellement des sous-répertoires
'Si SousRep = true
'Le répertoire source doit être dans Rep
Public Function LireRepertoir(ByVal Rep As String, Optional SousRep As Boolean) As Integer
Dim Obj, RepP, F, S, sf, F1, Fsous
Dim i As Integer, Ext As String
Dim Chem As String
Dim T As Double

  NBdata = 1
  ReDim Data(1 To 4, 1 To NBdata)
    Set Obj = CreateObject("Scripting.FileSystemObject")
    Set RepP = Obj.Getfolder(Rep)
    Chem = Rep: If Right(Chem, 1) <> "\" Then Chem = Chem & "\"

    Set sf = RepP.subfolders
    Set F = RepP.Files
    GoSub RempliData                        'les fichiers du répertoire principal
    If SousRep Then                         'les fichiers des sous-répertoires
        For Each Fsous In sf
            Set RepP = Fsous
            Set F = RepP.Files
            GoSub RempliData
        Next Fsous
    End If
Exit Function
'**********************************************************************
RempliData:
  For Each F1 In F
    NBdata = NBdata + 1
    ReDim Preserve Data(1 To 4, 1 To NBdata)
    Data(1, NBdata) = F1.ParentFolder & "\" & F1.Name
    Next F1

Return

End Function