.Replace What:=".", Replacement:=","

    Dim stlb As Object
    For Each stlb In Columns("D:E")
        stlb.TextToColumns Destination:=stlb.Cells(1), DataType:=xlDelimited, _
        FieldInfo:=Array(1, 1), DecimalSeparator:=".", TrailingMinusNumbers:=True
    Next

Option Explicit

Sub Knopka1()
    Dim sht As Object, as_sifr, i As Integer, kolist As Integer
    
    'Vypuskniki
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> "Menu" And sht.Name <> "Vypuskniki" Then
            as_sifr = Split(sht.Name, "_", -1, 1)
            If IsNumeric(as_sifr(0)) Then
                If as_sifr(0) = 11 Then
                    With Sheets("Vypuskniki")
                        With .Range("B" & .Rows.Count).End(xlUp)
                            sht.Range("B2").CurrentRegion.Copy .Offset(1, 0)
                            Application.CutCopyMode = False
                        End With
                    End With
                    Application.DisplayAlerts = False
                    sht.Delete
                    Application.DisplayAlerts = True
                End If
            End If
        End If
    Next
    ' 2 do 10
    kolist = ThisWorkbook.Worksheets.Count
    For i = kolist To 1 Step -1
        With ThisWorkbook.Worksheets(i)
            If .Name <> "Menu" And .Name <> "Vypuskniki" Then
                as_sifr = Split(.Name, "_", -1, 1)
                If IsNumeric(as_sifr(0)) Then
                    If as_sifr(0) > 1 Then .Name = as_sifr(0) + 1 & "_" & as_sifr(1)
                End If
            End If
        End With
    Next
    'Novyye 1
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> "Menu" And sht.Name <> "Vypuskniki" Then
            as_sifr = Split(sht.Name, "_", -1, 1)
            If IsNumeric(as_sifr(0)) Then
                If as_sifr(0) = 1 Then
                    sht.Name = "2" & "_" & as_sifr(1)
                    sht.Copy Before:=sht
                    ActiveSheet.Name = "1" & "_" & as_sifr(1)
                    ActiveSheet.Range("B2").CurrentRegion.ClearContents
                End If
            End If
        End If
    Next
    ThisWorkbook.Sheets("Menu").Select
End Sub

Range("H6").Value = Range(Range("R2").Value).Row

Option Explicit

Sub abc_xyz()
    Dim statusTNK
    
    statusTNK = Application.TransitionNavigKeys
    Application.TransitionNavigKeys = False
    
    Range("A1:D1").ClearContents
    Range("A1").Value = "'=C1+D1"
    Range("C1").Value = 1
    Range("D1").Value = 2
    
    If "'" = Range("A1").PrefixCharacter Then
        Range("B1").Formula = Range("A1").Value
    End If
    
    Application.TransitionNavigKeys = statusTNK
End Sub

Option Explicit

Sub qq()
    Dim shtFEP As Object
    Dim CSal As Integer
    Dim RSal As Long
    Dim frmla As String, frmlaRC As String
    Dim Pos, Div, RMot, CMot, yest
    
    Set shtFEP = ThisWorkbook.Sheets("Fayl EP")
    
    shtFEP.Activate
    
    For RSal = 2 To shtFEP.Cells(shtFEP.Rows.Count, "A").End(xlUp).Row
        Pos = shtFEP.Cells(RSal, "A").Value: Debug.Print Pos
        
        For CSal = 3 To 4
            Div = shtFEP.Cells(1, CSal).Value: Debug.Print Div
            
            With Worksheets("Motyvatsii")
                RMot = Application.Match(Pos, .Range("A1:A1000"), 0): Debug.Print RMot
                If IsError(RMot) Then MsgBox "Oshibka dlya 'Match-RMot'": Exit Sub
                
                CMot = Application.Match(Div, .Range("A1:AAA1"), 0): Debug.Print CMot
                If IsError(CMot) Then MsgBox "Oshibka dlya 'Match-CMot'": Exit Sub
                
                With .Cells(RMot, CMot)
                    frmlaRC = .FormulaR1C1: Debug.Print frmlaRC
                    yest = InStr(1, frmlaRC, Chr(39), vbTextCompare): Debug.Print yest
                    If yest = Null Then MsgBox "Oshibka dlya 'InStr-FormulaR1C1'": Exit Sub
                    
                    yest = yest + 1: Debug.Print yest
                    frmla = Mid(frmlaRC, yest, 1000): Debug.Print frmla
                End With
                
                shtFEP.Cells(RSal, CSal).FormulaR1C1 = frmla
            End With
        Next
    Next
    
    Set shtFEP = Nothing
End Sub

Sub xyz_abc()
    Const pth$ = "C:\Temp\"
    Const fle$ = "hsp.csv"
    If Dir(pth, vbDirectory) = "" Then _
        MsgBox "Net papki": Exit Sub Else MsgBox "Est' papka"
    
    If Dir(pth & fle, vbNormal) = "" Then _
        MsgBox "Net fayla:  " & fle Else MsgBox "Est' fayl"
    If Dir(pth & fle, vbHidden) = "" Then _
        MsgBox "Net fayla:  " & fle Else MsgBox "Est' fayl:  " & fle & "  no on skrytyy"
End Sub

x.Offset(0, 4).Sort x.Cells(1).Offset(0, 4), Header:=xlYes

x.Offset(0, 3).Sort x.Cells(1).Offset(0, 3), Header:=xlYes

Option Explicit

Sub qqq()
    Dim x As Range, y As Range
    
    Sheets("List1").Select
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set x = Range("B4:B10000")
    x.Offset(1, 3).Resize(x.Rows.Count - 1, 1).ClearContents
    x.AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
    Set y = x.Offset(1, 0).Resize(x.Rows.Count - 1, 1).SpecialCells(12)
    y.Copy
    [E5].PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    ActiveSheet.AutoFilterMode = False
    y.ClearContents
    y.Interior.ColorIndex = xlNone
    x.Sort x.Cells(1), Header:=xlYes
    x.Offset(0, 4).Sort x.Cells(1).Offset(0, 4), Header:=xlYes
    Range("E5").Select
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

    If Worksheets("SETTINGS").Cells(11, 15).Value = True Then
        papka = ThisWorkbook.Path & "\" & Trim(Sheets("ARX").[N2].Value)
        If Dir(papka, vbDirectory) = "" Then MkDir papka Else MsgBox "Папка с таким именем уже существует": Exit Sub
    End If

Option Explicit

Sub abc_xyz()
    Dim frgm$, znk$, znch$, dln%, i%, j%, yst%, r&: r = 1
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlManual
    
    Do Until Cells(r, "AC").Value = ""
        znch = LCase(Cells(r, "AC").Value)
        dln = Len(znch) - 3
        For i = 1 To dln
            frgm = Mid(znch, i, 4)
            znk = Mid(frgm, 1, 1)
            yst = 0
            For j = 2 To 4
                If Mid(frgm, j, 1) = znk Then yst = yst + 1
                If yst = 3 Then Exit For
            Next
            If j = 4 Then Exit For
        Next
        If j = 4 Then Rows(r).Delete Else r = r + 1
    Loop
    
    Application.Calculation = xlAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Option Explicit

Sub PasteToVisible_2()
    Dim i As Long, j As Long
    Dim crng As Range, prng As Range, sngarr As Range, rrow As Range
    
    Set crng = Application.InputBox("Diapazon kopirowaniya", "Zapros", "List1!$A$1:$D$4", Type:=8).SpecialCells(xlCellTypeVisible)
    Set prng = Application.InputBox("Diapazon vstavki", "Zapros", "List2!$A$1:$D$4", Type:=8).SpecialCells(xlCellTypeVisible)
    
    i = crng.Columns.Count
    j = prng.Columns.Count
    
    If i <> j Then MsgBox "Raznyy razmer diapazonov: 'Stolbtse' - Konets", vbCritical: Exit Sub
    
    i = 0
    j = 0
    
    For Each sngarr In crng.Areas
        i = i + sngarr.Rows.Count
    Next
    For Each sngarr In prng.Areas
        j = j + sngarr.Rows.Count
    Next
    
    If i <> j Then MsgBox "Raznyy razmer diapazonov: 'Stroki' - Konets", vbCritical: Exit Sub
    
    i = 0
    j = 0
    
    Sheets(prng.Parent.Name).Select
    
    For Each sngarr In crng.Areas
        i = i + 1
        For Each rrow In sngarr.Rows
            j = j + 1
            rrow.Copy prng.Areas(i).Rows(j).Cells(1)
            Application.CutCopyMode = False
        Next
        j = 0
    Next
End Sub

Option Explicit

Sub abc_xyz()
    Dim r As Long, rw As Long, yest
    
    r = 1: rw = 0
    Do Until Cells(r, "B").Value = ""
        yest = Application.Match(Cells(r, "B").Value, Columns("A:A"), 0)
        If TypeName(yest) = "Error" Then rw = rw + 1: Cells(rw, "C").Value = Cells(r, "B").Value
        r = r + 1
    Loop
End Sub

Sub abc()
    [F2].Formula = _
    "=SumIfs(" & _
    Range("E2:E25000").Address(0, 0) & ", " & _
    Range("A2:A25000").Address(0, 0) & ", " & """>=" & _
    "1/1/2019" & """" & ", " & _
    Range("A2:A25000").Address(0, 0) & ", " & """<=" & _
    "31/1/2019" & """" & ")"
End Sub

strSql = "SELECT * FROM [List1$] WHERE [Zagol3] <> '" & isk & "';"

Const isk$ = "уд"

For i = 1 To indc
    ThisWorkbook.Sheets("List1").Cells(1, i).Value = "Zagol" & CStr(i)
Next

With ThisWorkbook.Sheets("List2")
    .Select
    With .QueryTables.Add(Connection:=strCon, Destination:=.Range("A2"), Sql:=strSql)
        .FieldNames = True                    'или False
        .AdjustColumnWidth = False            'или True
        .RefreshStyle = xlInsertEntireRows
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End With

strCon = "ODBC;DSN=Excel Files;DBQ=" & dbPath & ";"

dbPath = ThisWorkbook.FullName

ThisWorkbook.Sheets("List2").Columns(nrc).Delete
'или
ThisWorkbook.Sheets("List2").Columns(adrs & ":" & adrs).Delete

With ThisWorkbook.Sheets("List1")
    For i = 1 To indc
        If Not IsError(Application.Match(isk, .Columns(i), 0)) Then
            nrc = i                                                         'Номер столбца с "уд"
            adrs = Split(.Columns(i).Cells(1).Address(1, 0), "$", -1, 1)(0) 'Адрес столбца с "уд"
            Exit For
        End If
    Next
End With

indc = ThisWorkbook.Sheets("List1").Range("A2").CurrentRegion.Columns.Count

Option Explicit

Sub ccc()
    Const isk$ = "уд"
    Dim c%, r&, ws As Worksheet
    With ThisWorkbook
        Set ws = .Sheets("Лист1")
        r = 2: c = ws.Range("A2").CurrentRegion.Columns.Count
        With .Sheets("Лист2")
            Do Until ws.Cells(r, "A").Value = ""
                If Not Join(Application.Index(ws.Cells(r, "A").Resize(1, c).Value, 0), " ") Like "*" & isk & "*" Then
                    .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Range("A" & r).Value
                    .Range("B" & .Rows.Count).End(xlUp).Offset(0, 1).Value = ws.Range("A" & r).Offset(0, 3).Value
                    .Range("B" & .Rows.Count).End(xlUp).Offset(0, 4).Value = ws.Range("A" & r).Offset(0, 1).Value
                End If
                r = r + 1
            Loop
        End With
    End With
    Set ws = Nothing
End Sub

Sub kazhdyye_x_stroki()
    Const shag& = 250
    Dim ur_rws&: ur_rws = ActiveSheet.UsedRange.Rows.Count
    If ur_rws = Rows.Count Then Exit Sub
    If ur_rws < shag Then Exit Sub
    Dim i&, r&, sklk&
    i = 1: r = 0
    sklk = ur_rws \ shag
    On Error Resume Next
    Do Until i = sklk
        r = r + 1 + shag
        Rows(r).Insert Shift:=xlDown
        If Err.Number <> 0 Then Exit Do
        i = i + 1
    Loop
    If Err.Number <> 0 Then Exit Sub
    If Application.CountA(Rows(r + 1 + shag)) <> 0 Then Rows(r + 1 + shag).Insert Shift:=xlDown
End Sub