Excel VBA skips a lot of occurrences - vba

Question

I have a Workbook with 6 Sheets. I am walking through them with For Each. And the task is:
1) Walk though every cell with specified Range
2) If cell is not empty AND contains ONLY number THEN add to the end of the cell " мм". Otherwise SKIP this cell.
But in fact, script does it good only for first sheet (Worksheet). It does no changes to other sheets. I don't know why this happens. I think, that there is some error or mistake in the code, but I double-checked it and everything seems to be correct. Help me please :)
Sub SaveWorksheetsAsCsv()
Dim xWs As Worksheet
Dim xDir As String
Dim folder As FileDialog
Dim r As Range
Dim rr As Range
Dim rrrrrr As Range
Dim cell As Range
k = Cells(Rows.Count, "A").End(xlUp).Row
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
For Each xWs In Application.ActiveWorkbook.Worksheets
If xWs.Name Like "Worksheet" Then
Set r = Range("FA2:FA" & k)
For Each cell0 In r
If IsEmpty(cell0.Value) = False And IsNumeric(cell0.Value) = True Then
cell0.Value = cell0.Value & " мм"
End If
Next
'xWs.Columns(41).EntireColumn.Delete
End If
If xWs.Name Like "Worksheet 1" Then
Set rr = Range("AG2:AG" & k)
For Each cell1 In rr
If IsEmpty(cell1.Value) = False And IsNumeric(cell1.Value) Then
cell1.Value = cell1.Value & " мм"
End If
Next
'xWs.Columns(126).EntireColumn.Delete
End If
If xWs.Name Like "Worksheet 5" Then
Set rrrrrr = Range("FR2:FR" & k)
For Each cell5 In rrrrrr
If IsEmpty(cell5.Value) = False And IsNumeric(cell5.Value) Then
cell5.Value = cell5.Value & " мм"
End If
Next
End If
xWs.SaveAs xDir & "\" & xWs.Name, xlCSV, local:=True
Next
End Sub

Answer 1

These sets of statements need to be adjusted to correct sheet references. Current code will always look at active sheet and the range reference is not qualified.
Set r = Range("FA2:FA" & k)
Set r = xWs.Range("FA2:FA" & k)

Answer 2

You can shorten-up and utilize your code a lot.
First, your k = Cells(Rows.Count, "A").End(xlUp).Row trying to get the last row, needs to be inside the For Each xWs In Application.ActiveWorkbook.Worksheets , since the last row will be different for each worksheet.
Second, instead of multiple Ifs, you can use Select Case.
Third, there is no need to have 3 different objects for Range, like r, rr, and rrr. The same goes for cell0, cell1 and cell5, you can use just one r and cell.
The only thing different inside your If (my Select Case) is the range you set r. The rest, looping through r.Cells is the same for all 3 criterias, so you can take this part outside the loop, and have it only once.
Modifed Code
Option Explicit
Sub SaveWorksheetsAsCsv()
Dim xWs As Worksheet
Dim xDir As String
Dim folder As FileDialog
Dim r As Range
Dim cell As Range
Dim k As Long
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
For Each xWs In ThisWorkbook.Worksheets ' it's safer to use ThisWorkbook is you reffer to the worksheets inside the workbook which thid code resides
With xWs
' getting the last row needs to be inside the loop
k = .Cells(.rows.Count, "A").End(xlUp).Row
Set r = Nothing ' reset Range Object
Select Case .Name
Case "Worksheet"
Set r = .Range("FA2:FA" & k)
'xWs.Columns(41).EntireColumn.Delete
Case "Worksheet 1"
Set r = .Range("AG2:AG" & k)
'xWs.Columns(126).EntireColumn.Delete
Case "Worksheet 5"
Set r = .Range("FR2:FR" & k)
End Select
' check if r is not nothing (it passed one of the 3 Cases in the above select case)
If Not r Is Nothing Then
For Each cell In r
If IsEmpty(cell.Value) = False And IsNumeric(cell.Value) Then
cell.Value = cell.Value & " мм"
End If
Next cell
End If
.SaveAs xDir & "\" & .Name, xlCSV, Local:=True
End With
Next xWs
End Sub