Cell string for multiple directoires /search multiple directoires

Sub DossierNummer() 
     
     
     
     
     
     
    ButeMacro = ActiveWorkbook.Name 
    Sheets("OverzichtInhoud").Select 
    Range("A22" & ActiveSheet.UsedRange.Rows.Count).ClearContents 
    Range("A2").Select 
     
     
    Sheets("StartPunt").Select 
    lrow = Range("E1", Selection.End(xlDown)).Count 'Dit is bedoeld om de namen van alle gekopieerde docs aan te geven, beginnend bij Cell E1 in Werkblad StartPunt
    [COLOR=#ff0000]fpath = Workbooks("" & ButeMacro & "").Sheets("StartPunt").Range("C3").Value[/COLOR] 'fpath is geeft de locatie aan waar gezocht wordt naar alle te kopieren bestanden
     
     
     
     
    get_filename 
    For i = 2 To lrow 
        If Range("E" & i).Value = "" Then 'startend vanaf E1 begint Excel vanaf de tweede cell beneden met het invullen van de namen van alle te kopieren bestanden. Waar Excel op een gegveen moment geen bestanden meer heeft en dus een lege cell heeft, stopt de Macro en wordt er een bericht gegenereerd.
            MsgBox "Gegevens staan nu klaar in de OverzichtInhoud!", vbInformation, "Status Kopiëren" 
            Exit Sub 
             
             
        Else 
             
             
            Fname = Workbooks("" & ButeMacro & "").Sheets("StartPunt").Cells(i, 5).Value 'Alle bestanden die Excel mbv de macro hierboven heeft gevonden en in Column E heeft geplaatst gaat hij nu 1voor1 af.
            Workbooks.Open Filename:=fpath & "" & Fname 
             
             
            mysht = ActiveWorkbook.Name '...Voor elk wb die excel vind
            Range("B4:B10,B29,B20,B24,B30,B31,B32,B33,B34,B35").Select '...gaat hij een aantal taken uitvoeren. hier bijvoorbeeld, gaat hij een rage cellen selecteren
            Selection.Copy 'hier heeft hij aan de ranges te kopieren
             
             
            Workbooks("" & ButeMacro & "").Activate '...vervolgens gaat hij, nadat hij de Worksheets heeft gekopieerd, terug naar de RapportageTool
            Sheets("OverzichtInhoud").Select 'Terug in de RapportageTool kiest excel het juiste werkblad
            Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True 'Nu plakt excel de data in rijvorm in plaaats van onder elkaar
             
             
             'ActivecellOffset>eerste deel is bedoeld om aan te geven hoeveel regels er tussen de waarden moet komen
             'In dit geval 0 geeft aan direct op de volgende regel eronder
             'De tweede 0 geeft aan dat de waarde direct in de eerste colum moet worden geplaatst
             
             
            ActiveCell.Offset(0, 0).Select 
            Workbooks("" & mysht & "").Activate 
            Range("B24").Select 
             
             
            ActiveCell.Offset(0, 0).Select 
            Workbooks("" & mysht & "").Activate 
            Range("B24").Select 
             
             
            Selection.End(xlDown).Select 
            Selection.Copy 
            Workbooks("" & ButeMacro & "").Activate 
            Selection.PasteSpecial Paste:=xlPasteValues 
            ActiveCell.Offset(1, 0).Select 
            Application.CutCopyMode = False 
            Sheets("StartPunt").Select 
            Workbooks("" & mysht & "").Activate 
            Application.DisplayAlerts = False 
            ActiveWorkbook.Close 
            Workbooks("" & ButeMacro & "").Activate 
        End If 
    Next 
End Sub 
Sub get_filename() 
    Dim fdr As String 
    mrow = 2 
    ButeMacro = ActiveWorkbook.Name 
    [COLOR="#FF0000"]spath = Range("C3").Value[/COLOR] 
    Range("E2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.ClearContents 
    Range("E2").Select 
    fdr = Dir(spath & "\" & "*.*") 
    Do While fdr <> "" 
        Cells(mrow, 5).Value = fdr 
        fdr = Dir 
        mrow = mrow + 1 
    Loop 
End Sub