Sub rneig()
Dim Iter1 As String
For i = 2 To 414
    Start = UCase(ThisWorkbook.Sheets(1).Cells(i, 11))
    posNom1 = InStr(Start, "№")
    posNom2 = InStr(Start, "N")
    If posNom1 > 0 Then
        Iter1 = Split(Start, "№")(1)
        posNom = posNom1
    ElseIf posNom2 > 0 Then
        Iter1 = Split(Start, "N")(1)
        posNom = posNom2
    End If
    
    posot = InStr(posNom, Start, "ОТ")
    posOther = RegularExpression(Iter1, "/(\d){2}")
    If posot > 0 Then
        Iter1 = Split(Iter1, "ОТ")(0)
    ElseIf posOther > 0 Then
        Iter1 = Mid(Iter1, 1, posOther + 4)
    End If
    ThisWorkbook.Sheets(1).Cells(i, 30) = Iter1
Next i
End Sub


Function RegularExpression(FindIn As String, Expr As String) As String
Set RegExp = CreateObject("VBScript.RegExp")
With RegExp
    .Global = False 'Все совпадения или только первое?
    .IgnoreCase = True 'Регистр неважен?
    .MultiLine = True 'Игнорировать переносы строк?
    .Pattern = Expr
End With
Set Matches = RegExp.Execute(FindIn)
RegularExpression = Matches.Item(0).FirstIndex
Set Matches = Nothing
Set RegExp = Nothing
End Function

Sub reign()
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Сводная" Then
    cnt = cnt + 1
    Sheets(1).Cells(cnt + 2, 2) = sh.Name
    
    Sheets(sh.Name).Range("B2") = sh.Name
End If
Next sh
End Sub

Private Sub CommandButton1_Click()
For i = 2 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
    dat = Sheets(1).Cells(i, 2)
    den = Day(dat)
    mes = MonthName(Month(dat))
    
    For j = 1 To 23
        If LCase(mes) = LCase(Replace(Sheets(2).Cells(j, 1), " ", "")) Then
            Sheets(2).Cells(j + 1, den).Interior.Color = vbYellow
        End If
    Next j
Next i
End Sub

    For Each c In Sheets("Sayfa1").Range("A2:A" & Sheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row)
        If c = selectedName Then
           
            'TextBox1.Text = Sheets("Sayfa1").Cells(c.Row, 2)
            Me.Tbx11.Value = Sheets("Sayfa1").Cells(c.Row, 1)
            Me.Tbx12.Value = Sheets("Sayfa1").Cells(c.Row, 2)
            Me.Tbx13.Value = Sheets("Sayfa1").Cells(c.Row, 3)
            Me.Tbx14.Value = Sheets("Sayfa1").Cells(c.Row, 4)
            Me.Tbx15.Value = Sheets("Sayfa1").Cells(c.Row, 5)
            Me.Tbx16.Value = Sheets("Sayfa1").Cells(c.Row, 6)
            Me.Tbx17.Value = Sheets("Sayfa1").Cells(c.Row, 7)
            Me.Tbx18.Value = Sheets("Sayfa1").Cells(c.Row, 8)
            Me.Tbx19.Value = Sheets("Sayfa1").Cells(c.Row, 9)
            Me.Tbx20.Value = Sheets("Sayfa1").Cells(c.Row, 10)
            Me.Tbx21.Value = Sheets("Sayfa1").Cells(c.Row, 11)
            Me.TBx22.Value = Sheets("Sayfa1").Cells(c.Row, 12)
            Me.TBx23.Value = Sheets("Sayfa1").Cells(c.Row, 13)
            Me.Tbx24.Value = Sheets("Sayfa1").Cells(c.Row, 14)
            Me.Tbx25.Value = Sheets("Sayfa1").Cells(c.Row, 15)
            Me.Tbx26.Value = Sheets("Sayfa1").Cells(c.Row, 16)
            Me.Tbx27.Value = Sheets("Sayfa1").Cells(c.Row, 17)
            Me.Tbx28.Value = Sheets("Sayfa1").Cells(c.Row, 18)
            Me.Tbx29.Value = Sheets("Sayfa1").Cells(c.Row, 19)
        End If
    Next c

    For Each c In Sheets("Sayfa1").Range("A2:A" & Sheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row)
        If c = selectedName Then

Private Sub CommandButton2_Click()
For i = 1 To 7
    If Controls("CheckBox" & i).Value = True Then
        fios = fios & vbLf & Controls("CheckBox" & i).Caption
    End If
Next i
ActiveCell.Value = fios
Unload Vibor_dokumenta
End Sub

Sub FindAndPaste()
    Dim whIn As Worksheet, whOut As Worksheet, objR As Range, lngI As Long, strS As String
    Set whIn = Worksheets("Лист2"): Set whOut = Worksheets("Лист1")
    Set objR = whIn.UsedRange.Find(whOut.Range("E5"))
    If Not objR Is Nothing Then
        For lngI = 2 To whIn.UsedRange.Columns.Count
            With whIn
                If .Cells(objR.Row, lngI) <> "" Then
                    If lngI <> whIn.UsedRange.Columns.Count Then
                        strS = strS & .Cells(objR.Row, lngI) & ", "
                    Else
                        strS = strS & .Cells(objR.Row, lngI)
                    End If
                End If
            End With
        Next lngI
Else
   Exit Sub
    End If
    whOut.Range("F5") = strS
End Sub