Private Sub UserForm_Initialize()
'(отбор уникальных значений)
Dim AllCells As Range, rCell As Range
Dim NoDupes As New Collection
Dim Item
     
    With Worksheets("справка")
    'Элементы находятся в столбце A
        Set AllCells = .Range("AA2:AA" & .Cells(Rows.Count, 27).End(xlUp).Row)
    End With
    'заполняем коллекцию элементами без повторений
    On Error Resume Next
    For Each rCell In AllCells
        NoDupes.Add rCell.Value, CStr(rCell.Value)
    Next rCell
    On Error GoTo 0
 
    'Добавление уникальных значений в  ComboBox
    For Each Item In NoDupes
        Me.ComboBox1.AddItem Item
    Next Item
End Sub
 
 
Private Sub ComboBox1_Change()
Dim i As Long, LastRow As Long, kategorija As String
    kategorija = Me.ComboBox1
    With Sheets("справка")
        LastRow = .Cells(Rows.Count, 27).End(xlUp).Row
        For i = 2 To LastRow
            If .Cells(i, 27) = kategorija Then
            End If
        Next
    End With
End Sub

Private Sub TextBox0_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.TextBox0.Value < 10 Then Me.TextBox0.Value = ""
End Sub

Private Sub TextBox1_Change()
If TextBox1 = "" Then Exit Sub
T = TextBox1
If Len(TextBox1) > 1 Then: If T > 75.9 Or T < 25.9 Then TextBox1 = "": MsgBox "неверный ввод" & vbNewLine & "Значения от 26,1 до 75,9, " & vbNewLine & "" & vbNewLine & "Пример    42,1", vbOKOnly + vbExclamation, ""
End Sub

     Range(Cells(10, y), Cells(31, y)).Copy Destination:=Cells(11, y)

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("E3:E26")) Is Nothing Then
    x = Target.Row
    Range(Cells(x, 10), Cells(x, 31)).Copy Destination:=Cells(x, 11)
    Cells(x, 10) = Target
End If
End Sub 

Private Sub CommandButton6_Click()

    x_text = ComboBox1
    Dim cell As Range
     Set cell = Columns(2).Find(What:=x_text, LookIn:=xlValues, LookAt:=xlWhole)
     
    If cell Is Nothing Then
        MsgBox "Ничего не найдено", vbCritical
    Else
        cell.Activate    ' выделяем найденную ячейку

    End If

End Sub

Sub filesave11()
Dim myDir As String
myDir = ThisWorkbook.Path & "\" & Format(Now, "dd.mm.yyyy") 

ActiveWorkbook.Save                'Сохранить
Application.DisplayAlerts = False  'Выкл

If Dir(myDir, vbDirectory) = "" Then MkDir (myDir)                
fname = myDir & "\" & "Улицы_" & Format(Now, "dd.mm.yyyy") & ".xlsb" 

Application.DisplayAlerts = True  'Вкл

End Sub

Sub Macros5()
Sheets("Лист1").Select
Set fcell = Columns("A:A").Find("Санкт-Петербург")
If Not fcell Is Nothing Then
    MsgBox "Санкт-Петербург Нашел в строке: " + CStr(fcell.Row)
Set fcell = Columns("A:A").Find("Москва")
If Not fcell Is Nothing Then
    MsgBox "Москва Нашел в строке: " + CStr(fcell.Row)
End If
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:J2")) Is Nothing Then
    UserForm1.Show 0
    UserForm1.Repaint
        On Error Resume Next
        ActiveSheet.ShowAllData
        Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:J2")
    End If
    Unload UserForm1
End Sub