Sub FindValueFromActiveCell()
    Dim SearchValue As String
    Dim FoundCell As Range
    Dim SearchRange As Range
    Dim SalesSheet As Worksheet
    
    ' Проверяем, существует ли лист "Продажи"
    On Error Resume Next
    Set SalesSheet = Worksheets("Продажи")
    On Error GoTo 0
    
    If SalesSheet Is Nothing Then
        MsgBox "Лист 'Продажи' не найден!", vbExclamation
        Exit Sub
    End If
    
    ' Значение для поиска берется из активной ячейки
    SearchValue = Replace(ActiveCell.Value, " ", "")
    
    ' Если ячейка пустая, выходим из макроса
    If SearchValue = "" Then
        MsgBox "Активная ячейка пуста!", vbExclamation
        Exit Sub
    End If
    
    ' Задаем область поиска - весь лист "Продажи"
    Set SearchRange = SalesSheet.UsedRange
    
    ' Ищем значение на листе "Продажи"
    Set FoundCell = SearchRange.Find(What:=SearchValue, LookIn:=xlFormulas)
    
    ' Проверяем, найдено ли значение
    If Not FoundCell Is Nothing Then
        ' Активируем лист "Продажи" и переходим к найденной ячейке
        SalesSheet.Activate
        FoundCell.Select
        MsgBox "Значение '" & SearchValue & "' найдено в ячейке: " & FoundCell.Address & " на листе 'Продажи'"
    Else
        MsgBox "Значение '" & SearchValue & "' не найдено на листе 'Продажи'!", vbInformation
    End If
End Sub

Sub КопироватьFull()
'Копирование нужной информации в Книге2
    Sheets("Full").Select
    ActiveSheet.Protect Password:="1111", UserInterfaceOnly:=True
    Range("A4:P5000").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
End Sub

Sub Hotkeys()
Application.OnKey "^+X", "КопироватьFull"
End Sub

Sub RunMacroAndPaste()
    Application.SendKeys "%{TAB}", True
    Application.Wait Now + TimeValue("00:00:01")
    Application.SendKeys "^+X", True
    Application.Wait Now + TimeValue("00:00:01")
    Application.SendKeys "%{TAB}", True
    Application.Wait Now + TimeValue("00:00:01")
    Range("A35").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub

    Application.SendKeys "%{TAB}", True
    Application.Wait Now + TimeValue("00:00:01")
    Range("A35").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Sub Reverse_Word()
 On Error Resume Next
 ActiveCell.Value = StrReverse(ActiveCell.Value)
End Sub

    Dim s$, I&, j&
     s = Selection
    
  For I = 1 To Len(s)
   j = AscW(Mid$(s, I, 1))
   If j < 256 Then
       Mid$(s, I, 1) = Chr(j)
       Debug.Print I & vbTab & Mid$(s, I, 1) & vbTab & j & vbTab & Chr(j)
   End If
   Next
 
   ActiveCell.Value = s
End Sub

    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "=TRIM(RC[1])"
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A5000")
    ActiveCell.Range("A1:A5000").Select
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.Copy
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.NumberFormat = "@"