Sub НазваниеМакроса()
For Each a In Selection.SpecialCells(xlCellTypeFormulas).Areas
a.Copy a.Offset(, 1).Resize(, InputBox("", "", 1))
Next
End Sub

Function определятель_1(rrr As Range) As Integer
определятель_1 = CInt(Rows(rrr.Row).EntireRow.Hidden) + 2
End Function

Sub www()
[c8:c11] = CDate(Split([c3], " ")(2))
End Sub

Sub Отевт_на_Вопорс() 'в код листа 1
With Sheets(2)
i = 0
For Each rr In Columns(1).SpecialCells(2).Areas
rr.Copy Destination:=Sheets(2).Cells(2, 3).Offset(, i): i = i + 1
Next
End With
Beep
End Sub

Sh_Klientu.Range("C2").Resize(UBound(dx) + 1).Value = Application.Transpose(dx)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Cells(2, Target.Column + 1) <> "¹" Or Target.Count > 1 Then Exit Sub
r = Cells(Rows.Count, Target.Column + 1).End(xlUp).Row
If Not Intersect(Target, Range(Cells(3, Target.Column), Cells(r, Target.Column))) Is Nothing Then
MsgBox "Bingo!"
End If
End Sub

Sub www()
For Each x In Columns(1).SpecialCells(2)
xx = Split(x, " ")(UBound(Split(x, " ")))
  If IsNumeric(Left(xx, 1)) Then x.Offset(, 1) = xx:   x.Value = Replace(x, xx, "")
Next x
End Sub