Dim r As Long, rng As Range
    'удаляем пустые строки
    For r = 1 To ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
        If Application.CountA(Rows(r)) = 0 Then
            If rng Is Nothing Then Set rng = Rows(r) Else Set rng = Union(rng, Rows(r))
        End If
    Next r
    If Not rng Is Nothing Then rng.Delete

Sub Peremen()
    Dim Pr1, Pr2, Psr1, Pr3, Dfg, Hdfr1, Hdfr2, Hdfr5 As String
    Pr1 = "A"
    Pr2 = "B"
    Psr1 = "C"
    Pr3 = "D"
    Dfg = "E"
    Hdfr1 = "F"
    Hdfr2 = "G"
    Hdfr5 = "H"
    'и так в ручную для вех столбцов
End Sub

=ЕСЛИ(НАЙТИ("AAA";ПРОПИСН($C1));"AAA";ЕСЛИ(НАЙТИ("BBB";ПРОПИСН($C1));"BBB";""))

  Dim xlApp As Object, xlWorkbook As Object
  Set xlApp = CreateObject("Excel.Application")
  Set xlWorkbook = xlApp.Workbooks.Open("C:\path\workbook.xlsm")

    Dim iText As String, strfile As String
    Dim kolstrok As Long
    myFile = FreeFile
    Open ("C:\Пример.txt") For Input As #myFile
         iText = Input(LOF(1), #myFile)
         kolstrok = UBound(Split(iText, vbNewLine)) + 1 'Количество строк в текстовом файле
    Close #myFile

    Open ("C:\Пример.txt") For Input As #myFile
        Do While Not EOF(myFile)
            Line Input #myFile, strfile
            If strfile <> "" Then iText = strfile 'Текст последней непустой строки
        Loop
    Close #myFile 

ActiveSheet.Range("$A$2:$C$95").AutoFilter Field:=3, Criteria1:=">=01.12.2022", Operator:=xlAnd, Criteria2:="<=03.12.2022"

ActiveSheet.Range("$A$2:$C$95").AutoFilter Field:=3, Criteria1:=">=01.12.2022", Operator:=xlAnd

Dim rng As Range
For Each rng In Range("A1:A10")
    msgbox rng.Value
Next