Excel VBA works only on the last sheet - vba

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