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

Sub ЕстьФильтр_1()
With ActiveSheet.AutoFilter.Range
x = .Columns(3).SpecialCells(2, 1).SpecialCells(12).Address
End With
End Sub

[E1].Resize(UBound(Peremennaya_Massiva)).Value = Application.Transpose(Peremennaya_Massiva)