MsgBox Cells.Find("*", [A1], xlValues, xlPart, xlByRows, xlPrevious).Row

MsgBox [AK:AK].Find("*", [AK1], xlValues, xlPart, xlByRows, xlPrevious).Row

Sub InsRows()
    Dim i As Long, x As Range
    Application.ScreenUpdating = False
    Set x = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    With Sheets(2)
        x.Copy .[A2]
        Set x = .Range(x.Address)
        For i = x.Row + x.Rows.Count - 1 To x.Row + 2 Step -1
            If x.Cells(i) <> x.Cells(i - 1) Then x.Cells(i).Insert
        Next
    End With
End Sub

Sub qq()
    Dim i As Long, r1 As Long, r2 As Long
    r1 = 3
    r2 = ActiveSheet.UsedRange.Rows.Count + 1
    For i = 1 To 7: Cells(r2, i) = Cells(r1, i): Next
End Sub

MsgBox [A:A].Find("*", [A1], xlValues, , , xlPrevious).Row

Sub Random()
    Dim i As Long: Application.ScreenUpdating = False
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Cells(i, "H") = Randomize3(Cells(i, 1).Resize(, 7))
    Next
End Sub

Function Randomize3(Rng As Range) As String
    Dim a(), i As Long, j As Long, k As Long, x
    a = Application.Index(Rng.Value, 1, 0)
    For k = 1 To 1000
        i = Int(1 + (UBound(a) * Rnd))
        j = Int(1 + (UBound(a) * Rnd))
        x = a(i): a(i) = a(j): a(j) = x
    Next
    Randomize3 = Join(a)
End Function

Function Randomize3(Rng As Range) As String
    Dim a(), i As Long, j As Long, k As Long, x
    a = Application.Index(Rng.Value, 1, 0)
    For k = 1 To 1000
        i = Int(1 + (UBound(a) * Rnd))
        j = Int(1 + (UBound(a) * Rnd))
        x = a(i): a(i) = a(j): a(j) = x
    Next
    Randomize3 = Join(a)
End Function

Sub InsertNull()
    On Error Resume Next
    [B:B].SpecialCells(4).Offset(, -1) = 0
End Sub

Private Sub TextBox1_Change()
    If Len(TextBox1) > 5 Then
        If Right$(TextBox1, 5) Like ".####" Then
            'Ваше действие
        End If
    End If
End Sub

 =ВПР(BD21;Данные!B2:C6;2)

Sub qq()
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.AlternativeText = "Вариант 1" Then sh.ControlFormat.Value = 1
    Next
End Sub

 [D4].AutoFill Range("D4:D" & Cells(Rows.Count, "C").End(xlUp).Row), xlFillDefault

x = StrReverse(Val(StrReverse(folderPath)))

On Error Resume Next: Sheets("имя").Delete: On Error GoTo 0

[M:M].SpecialCells(4).EntireRow.Delete

Sub DelRows()
    Dim x As Range, y As Range
    Set x = Range("C2:C" & Cells(Rows.Count, 3).End(xlUp).Row + 1)
    Set y = x.Find("Ксения", LookAt:=xlWhole)
    If y Is Nothing Then x.EntireRow.Delete Else x.ColumnDifferences(y).EntireRow.Delete
End Sub

Sub qq()
    Dim w As Integer: w = 3 'Задаем требуемый размер
    With [A1:F6] 'Задаем диапазон ячеек
        .ColumnWidth = w 'Устанавливаем ширину столбца
        .RowHeight = .Cells(1).Width 'Уравниваем высоту строки
    End With
End Sub

Sub tSystem()
    Dim i As Long: Application.ScreenUpdating = False
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Cells(i, 13).Validation.Delete: Cells(i, 13) = ""
        If Cells(i, 4) <> "" Then Cells(i, 13).Validation.Add xlValidateList, xlValidAlertStop, Formula1:="=Тип_системы"
    Next
End Sub

Sub MyMultiply()
    Dim x As Range: Application.ScreenUpdating = False
    Set x = Range("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    x.Offset(, 1).Value = x.Value
    x.Offset(, -1).Copy
    x.Offset(, 1).PasteSpecial xlPasteValues, xlMultiply
    On Error Resume Next 'На случай, если нет ячеек с текстом
    x.Offset(, 1).SpecialCells(2, 2).ClearContents
    On Error GoTo 0
End Sub

Sub qq()
    Application.ScreenUpdating = False: On Error Resume Next
    [B:B].SpecialCells(2).Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
    [C:C].SpecialCells(2).Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
    [A:A].SpecialCells(4).Delete xlUp
End Sub

Sub DelRows()
    Dim i As Long, j As Long, k As Long, x As Range
    k = ActiveCell.Column
    Application.ScreenUpdating = False: i = 1
    Do While i < Cells(Rows.Count, k).End(xlUp).Row
        j = Columns(k).Find(Cells(i, k), SearchDirection:=xlPrevious).Row
        If j - i > 1 Then If x Is Nothing Then Set x = Rows(i + 1 & ":" & j - 1) _
            Else Set x = Union(x, Rows(i + 1 & ":" & j - 1))
        i = j + 1
    Loop
    If Not x Is Nothing Then x.Delete
End Sub

Sub DelRows()
    Dim i As Long, j As Long, x As Range
    Application.ScreenUpdating = False: i = 1
    Do While i < Cells(Rows.Count, 2).End(xlUp).Row
        j = [B:B].Find(Cells(i, 2), SearchDirection:=xlPrevious).Row
        If j - i > 1 Then If x Is Nothing Then Set x = Rows(i + 1 & ":" & j - 1) _
            Else Set x = Union(x, Rows(i + 1 & ":" & j - 1))
        i = j + 1
    Loop
    If Not x Is Nothing Then x.Delete
End Sub

Do While j < DateAdd("m", 1, Date)

Do While j <= Date

Sub Учебный2()
    Dim k As Integer, j As Date
    j = #1/1/2017# ' дата начала анализа
    k = 5
    Do While j <= Date
        Cells(2, k) = Format(j, "mmmm yyyy")
        MsgBox Cells(2, k)
        j = DateAdd("m", 1, j)
        k = k + 1
    Loop
End Sub

Sub qq()
    If IsDate(Sheets(1).Name) Then
        Sheets(1).Copy Before:=Sheets(1)
        ActiveSheet.Name = CDate(Sheets(2).Name) + 1
    Else
        MsgBox "Имя 1-го листа - это не дата!"
    End If
End Sub

Sub qq()
    Dim x As Range
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Set x = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    x.TextToColumns [B1], OtherChar:="-"
    x.Resize(, 3) = Application.Trim(x.Resize(, 3))
End Sub