Zoeken op bestandsnaam beginnend op "Worksheet" en format xlsm
Goedemiddag allen,
Ik ben net begonnen met VBA en heb geprobeerd een code samen te stellen mbv verschillende sites.
de code werkt prima, alleen zou ik graag willen dat de macro in de opgegeven directory zoekt naar alle xlsm bestanden beginnend met keyword "Worksheet".
Zou iemand mij hiermee kunnen helpen?
mijn code ziet er als volgt uit: alvast dank.
Sub DossierNummer()
ButeMacro = ActiveWorkbook.Name
Sheets("OverzichtInhoud").Select
Range("A2
2" & 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
fpath = Workbooks("" & ButeMacro & "").Sheets("StartPunt").Range("C3").Value '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
spath = Range("C3").Value
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
