Assegnare automaticamente nomi in sequenza corretta a Range uguali tra loro

Sub test()
Dim ur, x, nome, S, T, F, vS, vT, vF
ur = Range("A" & Rows.Count).End(xlUp).Row
vS = 1
vT = 1
vF = 1
For x = 1 To ur Step 47
    IF Cells(x + ??, ??)= "saldatori" then
        nome = Cells(x + 4, 27).Value & "_" & vS
        ActiveWorkbook.Names.Add Name:=nome, RefersTo:=Sheets(1).Range(Rows(x), Rows(x + 46))
        vS = vS + 1
    elseIF Cells(x + ??, ??)= "tornitori" then
        nome = Cells(x + 4, 27).Value & "_" & vT
        ActiveWorkbook.Names.Add Name:=nome, RefersTo:=Sheets(1).Range(Rows(x), Rows(x + 46))
        vT = vT + 1
    elseIF Cells(x + ??, ??)= "fresatori" then
        nome = Cells(x + 4, 27).Value & "_" & vF
        ActiveWorkbook.Names.Add Name:=nome, RefersTo:=Sheets(1).Range(Rows(x), Rows(x + 46))
        vF = vF + 1
End If
Next x
End Sub

Option Explicit
    Sub EliminaNomi() ' http://ennius.altervista.org/vba/vba103.php
    Dim G, X As Integer
    X = ActiveWorkbook.Names.Count  'con X otteniamo il numero di quanti nomi sono nel workbook
        For G = X To 2 Step -1      'si inizia un ciclo a scalare, usando G come contatore del ciclo
            ActiveWorkbook.Names(G).Delete   'e si cancella il nome il cui numero indice ? uguale al contatore (G)
        Next
    End Sub
Sub Prova()
Dim ur As Long, X As Long, Maschio, Donna, Nome As String
Call EliminaNomi
ur = Range("B" & Rows.Count).End(xlUp).Row
For X = 1 To ur Step 47
    If Cells(X + 6, 14) = "X" Or Cells(X + 6, 20) = "X" Then
        Nome = ""
        If Cells(X + 6, 14) = "X" Then Nome = "M_": Maschio = Maschio + 1 ' Nome = "Maschio_"
        If Cells(X + 6, 20) = "X" Then Nome = "D_": Donna = Donna + 1 ' Nome = "Donna_"
        If Cells(X + 9, 14) = "X" Then Nome = Nome & "T_"
        If Cells(X + 9, 20) = "X" Then Nome = Nome & "F_"
        If Cells(X + 12, 7) = "X" Then Nome = Nome & "M_"
        If Cells(X + 12, 10) = "X" Then Nome = Nome & "S_"
        If Cells(X + 12, 17) = "X" Then Nome = Nome & "E_"
        If Cells(X + 6, 14) = "X" Then
            Nome = Nome & Format(Maschio, "000")
        Else
            Nome = Nome & Format(Donna, "000")
        End If
        'Se desideri usa tutta la riga ...Range(Rows(x), Rows(x + 46))
        ActiveWorkbook.Names.Add Name:=Nome, RefersTo:=Sheets("Foglio1").Range(Cells(X, 2), Cells(X + 46, 23))
    End If
Next X
MsgBox "Fatto"
End Sub

Sub Nascondi_Maschio()
Dim ur As Long, X As Long
ur = Range("B" & Rows.Count).End(xlUp).Row
    For X = 1 To ur Step 47
        If Cells(X + 6, 14) = "" Then
            Range(Rows(X), Rows(X + 46)).EntireRow.Hidden = True
        End If
    Next
MsgBox "Fatto"
End Sub
Sub Nascondi_Donna()
Dim ur As Long, X As Long
ur = Range("B" & Rows.Count).End(xlUp).Row
    For X = 1 To ur Step 47
        If Cells(X + 6, 20) = "" Then
            Range(Rows(X), Rows(X + 46)).EntireRow.Hidden = True
        End If
    Next
MsgBox "Fatto"
End Sub
Sub Scopri_tutto()
    Cells.EntireRow.Hidden = False
End Sub

Private Sub CommandButton16_Click()
On Error GoTo finito
Dim nome, rg As Object
Dim ur As Long
Worksheets("Foglio1").Activate
ur = Range("B" & Rows.Count).End(xlUp).Row
Set rg = Columns("C:C").Find(nome, LookIn:=xlValues, LookAt:=xlWhole)
If Not rg Is Nothing Then
    Range(Cells(1, 1), Cells(ur, 23)).Select
End If
             If Application.Dialogs(xlDialogPrinterSetup).Show Then
                  ActiveWindow.RangeSelection.PrintOut
             End If
Range("A1").Select
finito:
End Sub