r.Characters(400).InsertAfter vblf 

Sub Test(): Dim iPDFCreator, s
    Set iPDFCreator = CreateObject("PDFCreator.JobQueue")
    s = iPDFCreator.cOption("UseAutosave")
End Sub

Sub mgbeg()
    Лист1.Range("$A$3:$A$1373").Clear: Лист18.Range("$A$3:$A$1373").EntireRow.Copy
    Лист1.Range("$A$3:$A$1373").EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

    For Each iCells In Obl                                                                                                          'Запоминаем уникальные значения высоты строк в коллекцию
        On Error Resume Next: 
        If iCells <> "" Then Coll.Add CStr(iCells.RowHeight), CStr(iCells.RowHeight)
        If NewObl Is Nothing Then Set NewObl = iCells Else Set NewObl = Union(NewObl, iCells)
        On Error GoTo 0
    Next iCells: 
    iОбласть(i) = NewObl.Address
В итоге получается 2-а массива (высота строк, адрес области)

NewObl.Select

Debug.Print NewObl.Address

Sub DateCells()
    'Date()— возвращает текущую системную дату
    ActiveCell.Value = DateSerial(Year(Date), Month(Date), 1)              'Первый день
    ActiveCell.Cells(2,1).Value= DateSerial(Year(Date), Month(Date) + 1, 0)          'Последний день
End Sub

Columns(2).Select

Call StartSound("ir_inter.wav", 2)

Sub uuu()    Dim i&
    Dim c As Range
'------------------
    Application.ScreenUpdating = False
    For Each c In ActiveSheet.UsedRange.Cells
        If c.Value <> "" Then
            For i = Len(c.Value) To 1 Step -1
                With c.Characters(Start:=i, Length:=1)
                    If .Font.Superscript = True Then .Delete
                End With
            Next
        End If
    Next
    Application.ScreenUpdating = True
    Beep
    MsgBox "Готово!"
End Sub