Excel VBA works only on the last sheet

Question

I have macro below which run an all sheets in workbook and it run through all files in specific directory. But unfortunately it works only for the last sheet in each workbook. It should work for every sheet. Can someone correct my code?

Sub LoopThroughFiles()
    Application.ScreenUpdating = False
    FolderName = "C:\Users\Karolek\Desktop\E\3\"
    If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
    Fname = Dir(FolderName & "*.xls")

    'loop through the files
    Do While Len(Fname)

        With Workbooks.Open(FolderName & Fname)

           ' here comes the code for the operations on every file the code finds

           Call LoopThroughSheets

        End With

        ' go to the next file in the folder
        Fname = Dir

    Loop

End Sub

Sub LoopThroughSheets()

    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets

    Call naprawa

    Next ws
    ActiveWorkbook.Close savechanges:=True
End Sub



Sub naprawa()

    Dim fndList As Variant
    Dim rplcList As Variant
    Dim x As Long

    fndList = Array("Louver-", "Lvrs ", "gauge ", "Galvanized ", "Pieces")
    rplcList = Array("Lvr-", "Louvers ", "ga ", "Glvnzd ", "Pcs")
    For x = LBound(fndList) To UBound(fndList)
    Range("C:C,D:D").Select
    Selection.Replace What:=fndList(x), Replacement:=rplcList(x), LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Next x

End Sub

Answer 1

Why does this need to be in three separate subs? This can be accomplished in a single sub:

Sub LoopThroughFiles()

    Dim ws As Worksheet
    Dim lCalc As XlCalculation
    Dim sFldrPath As String
    Dim sFileName As String
    Dim aFindList() As String
    Dim aRplcList() As String
    Dim i As Long

    sFldrPath = "C:\Test\"
    If Right(sFldrPath, 1) <> Application.PathSeparator Then sFldrPath = sFldrPath & Application.PathSeparator
    sFileName = Dir(sFldrPath & "*.xls*")

    aFindList = Split("Louver-,Lvrs ,gauge ,Galvanized ,Pieces", ",")
    aRplcList = Split("Lvr-,Louvers ,ga ,Glvnzd ,Pcs", ",")

    With Application
        lCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    On Error GoTo CleanExit

    'loop through the files
    Do While Len(sFileName) > 0
        With Workbooks.Open(sFldrPath & sFileName)
            For Each ws In .Sheets
                For i = LBound(aFindList) To UBound(aFindList)
                    ws.Range("C:D").Replace aFindList(i), aRplcList(i), xlPart
                Next i
            Next ws
            .Close True
        End With

        ' go to the next file in the folder
        sFileName = Dir
    Loop

CleanExit:
    With Application
        .Calculation = lCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub