Pattern = "\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}"

Pattern = "19\.10\.\d{1,3}\.\d{1,3}"

Selection.SpecialCells(xlCellTypeVisible).Copy

Sub AutoCallMacro()
    Dim M As String
   M = Range("A1").Value
    Application.Run "Macro" & M
End Sub
Sub Macro1()
Range("A3").Select
End Sub
Sub Macro2()
Range("A5").Select
End Sub

Sub mac()
Dim M As String
   M = Range("A1").Value
Application.Run "mac" & M
End Sub

ShuavForm1.TextBox19.Value = Sheets("КС2").Cells(31, 8).FormulaLocal

Sheets(КС2).Cells(31, 8).FormulaLocal

Sheets(КС2).Cells(31, 8).Cells(1,1).FormulaLocal

Private Sub CommandButton1_Click()
Dim m As Integer
Dim x As Integer
Dim out As Integer
dim lr as long
for lr = 2 to 10
m = Cells(lr, 1)
x = Cells(lr, 2)
out = Cells(lr, 3)
      
     For i = m To x Step -x
        If i > 0 Then
            i = i - out
            j = j + 1
        End If
        If I < 0 Then
            i = i + out
            Exit For
        End If
    Next i
  
 
Cells(lr, 4) = j
Cells(lr, 5) = j + 1
Cells(lr, 6) = i
Next
End Sub

path & Application.PathSeparator & ThisWorkbook.ActiveSheet.Name & " " & ThisWorkbook.Worksheets("Лист1").Range("B10").Value & ".xlsx"

Sub Сохранить_лист()
Application.ScreenUpdating = False
Dim path As String, iLinks As Variant, I As Long
 
vopros = MsgBox("Сохранить форму?", vbYesNo, "Сохранение")
If vopros = vbYes Then
 
    path = ThisWorkbook.path
    Dim sFName$
    sFName = path & Application.PathSeparator & ActiveSheet.Name & " " & ActiveWorkbook.Worksheets("Лист1").Range("B10").Value & ".xlsx"
    ActiveSheet.Copy
    iLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
        If Not IsEmpty(iLinks) Then
            For I = 1 To UBound(iLinks)
            ActiveWorkbook.BreakLink Name:=iLinks(I), Type:=xlExcelLinks
            Next I
        End If
    
    If ActiveSheet.Shapes.Count > 0 Then ActiveSheet.Shapes(1).Delete           'удаляю кнопку СОХРАНЕНИЯ в новом файле!!!
     ActiveWorkbook.SaveAs sFName, FileFormat:=xlOpenXMLWorkbook  'не работает
    
     ActiveWorkbook.Close (False)
     MsgBox "Форма сохранена в текущую папку.", vbInformation, "Сообщение:"
End If
End Sub

ActiveWorkbook.SaveAs path & Application.PathSeparator & ActiveSheet.Name & " " & ActiveWorkbook.Worksheets("Лист1").Range("B10").Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook