Run a VBA excel macro on all files in a folder

Question

I'm faceing a problem were my macro that works for a single excel workbook needs to be able to work for all workbooks in a folder. The macro does multiple things: 1) opens and saves all sheets in a workbook to specific location 2) Extracts title from a graph to T99 if graph exists 3) removes all rows before any column contains a keywords ("datum"). It works very well but I have 100s of workbooks that I want to run this macro on.

Here is the original macro:

Sub b2()

Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String
Dim fRg As Range


    Set wbThis = ThisWorkbook
    For Each ws In wbThis.Worksheets
        strFilename = wbThis.Path & "/singlesheets/" & ws.Name
        ws.Copy
        Set wbNew = ActiveWorkbook
        On Error Resume Next
            Sheets(1).ChartObjects(1).Activate
    
            If Err.Number <> 0 Then
            Else
                Worksheets(1).Range("T99").Value = Worksheets(1).ChartObjects("Chart 1").Chart.ChartTitle.Text
            End If
        Set fRg = Cells.Find(What:="datum", LookAt:=xlWhole)
     
        If Not fRg Is Nothing Then
            If fRg.Row <> 1 Then
                    Range("A1", fRg.Offset(-1)).EntireRow.Delete
            Else
            End If
        Else
        End If
        wbNew.SaveAs strFilename
        wbNew.Close
    Next ws

End Sub

and here is my non-functioning module that repeatedly conducts the above macro on the same workbook but does not continue to the next workbook within the folder:

Sub LoopThroughFiles()

Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
    xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    xFileName = Dir(xFdItem & "*.xls*")
    Do While xFileName <> ""
        With Workbooks.Open(xFdItem & xFileName)
            'your code here
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String
Dim fRg As Range

Set wbThis = ThisWorkbook
For Each ws In wbThis.Worksheets
    strFilename = wbThis.Path & "/singlesheets/" & ws.Name
    ws.Copy
    Set wbNew = ActiveWorkbook
    On Error Resume Next
        Sheets(1).ChartObjects(1).Activate

        If Err.Number <> 0 Then
        Else
            Worksheets(1).Range("T99").Value = Worksheets(1).ChartObjects("Chart 1").Chart.ChartTitle.Text
        End If
    Set fRg = Cells.Find(What:="datum", LookAt:=xlWhole)
 
    If Not fRg Is Nothing Then
        If fRg.Row <> 1 Then
                Range("A1", fRg.Offset(-1)).EntireRow.Delete
        Else
        End If
    Else
    End If
    wbNew.SaveAs strFilename
    wbNew.Close
Next ws
        End With
        xFileName = Dir
    Loop
End If

End Sub

Answer 1

As noted in the comments, it's easier to manage your code if you create methods which don't do too many things...

Sub ProcessFolder()
    Dim xFd As FileDialog, xFdItem As Variant, xFileName As String
    Dim wb As Workbook
    
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    xFd.AllowMultiSelect = False
    If xFd.Show <> -1 Then Exit Sub
    
    xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    xFileName = Dir(xFdItem & "*.xls*")
    Do While xFileName <> ""
        
        Set wb = Workbooks.Open(xFdItem & xFileName)
        ProcessWorkbook wb 'export all sheets
        wb.Close False
        
        xFileName = Dir() 'next file
    Loop
End Sub

Sub ProcessWorkbook(wb As Workbook)
    Dim ws As Worksheet, fRg As Range
    Dim wsNew As Worksheet
    
    For Each ws In wb.Worksheets
        ws.Copy
        Set wsNew = ActiveWorkbook.Worksheets(1) 'get the copied sheet
        
        On Error Resume Next 'ignore any chart/chart title error
        wsNew.Range("T99").Value = wsNew.ChartObjects(1).Chart.ChartTitle.Text
        On Error GoTo 0
        
        Set fRg = wsNew.Cells.Find(What:="datum", LookAt:=xlWhole)
        If Not fRg Is Nothing Then
            If fRg.Row > 1 Then wsNew.Range("A1", fRg.Offset(-1)).EntireRow.Delete
        End If
        'save and close the sheet copy
        wsNew.Parent.SaveAs wb.Path & "/singlesheets/" & ws.Name ' & ".xlsx" ?
        wsNew.Parent.Close False
    Next ws
End Sub