Распределение строк по условию (Дате)

Option Explicit         ' Обязательное объявление переменных
Option Compare Text     ' отсутствие чувствительности к регистру при сравнении символов
 
Sub Перенос_ячеек()
    Const FirstRow& = 2 ' Константа - первая строка данных ниже шапки на всех листах
    Dim i&, j&, LastRow&, LastRowTarget&, ShName, Sh_Target As Worksheet, Prefix$, FormulaRC$, A
    Application.ScreenUpdating = False ' Временное отключение обновления экрана в Excel
    For Each ShName In Array("Не выполнено РУТН", "РУТН со сроком месяц", "РУТН со сроком месяц+1") ' Цикл по 3 листам с результатами для очистки старых данных
        With Sheets(ShName) ' Работа с объектом Sheet через символ "."
            LastRowTarget = .Cells(.Rows.Count, "A").End(xlUp).Row ' Определение последней заполненной строки по столбцу A
            If LastRowTarget < FirstRow Then LastRowTarget = FirstRow  ' последняя заполненная строка не должна быть меньше FirstRow  (=2)
            .Rows(FirstRow & ":" & LastRowTarget).Clear    ' Удаление строк со старыми данными при новом распределении
        End With
    Next ShName
    With owssvr ' Работа с объектом owssvr (программное имя объекта) через символ "."
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row  ' Определение последней заполненной строки по столбцу A
        A = .Range(.Cells(1, 1), .Cells(LastRow, 10)).Value ' Формируем массив для проверки условий
        For i = FirstRow To LastRow ' Цикл по строкам анализируемого листа
            If A(i, 7) <= Sheets("Формулы").Range("D5") And A(i, 7) >= Sheets("Формулы").Range("E7") Then ' Комплекс условий 1
                Set Sh_Target = "Не выполнено" ' Объектная ссылка на лист цель.
          ElseIf A(i, 7) >= Sheets("Формулы").Range("D5") And A(i, 7) <= Sheets("Формулы").Range("D2") Then ' Комплекс условий 2
                Set Sh_Target = "со сроком месяц" ' Объектная ссылка на лист цель."
          ElseIf A(i, 7) >= Sheets("Формулы").Range("E2") And A(i, 7) <= Sheets("Формулы").Range("F2") Then ' Комплекс условий 3
                Set Sh_Target = "со сроком месяц+1" ' Объектная ссылка на лист цель.
            End If
            .Range(.Cells(i, 1), .Cells(i, "J")).Copy  ' копирование  i-той строки (по J,для последующей вставки форматов)
            With Sh_Target '  Работа с объектом листом-целью, куда копируем форматы, через символ "."
                 LastRowTarget = .Cells(.Rows.Count, "Z").End(xlUp).Row + 1 ' Определение последней пустой строки по столбцу Z
                 If LastRowTarget < FirstRow Then LastRowTarget = FirstRow
                .Cells(LastRowTarget, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' вставка скопированных форматов
                .Rows(LastRowTarget).RowHeight = Лист1.Rows(i).RowHeight ' Выравнивание высоты строки по исходной
                .Range(.Cells(LastRowTarget, 1), .Cells(LastRowTarget, "AU")).FormulaR1C1 = FormulaRC  ' заполнение целевого диапазона ссылочными формулами
            End With
        Next i
    End With
    Set Sh_Target = Nothing ' Очистка памяти от объектных ссылок
End Sub

Option Explicit         ' Обязательное объявление переменных
Option Compare Text     ' отсутствие чувствительности к регистру при сравнении символов
 
Sub Распределение()
    Const FirstRow& = 2 ' Константа - первая строка данных ниже шапки на всех листах
    Dim i&, j&, LastRow&, LastRowTarget&, ShName, Sh_Target As Worksheet, Prefix$, FormulaRC$, A
    For Each ShName In Array("1", "2", "3") ' Цикл по 3 листам с результатами для очистки старых данных
        With Sheets(ShName) ' Работа с объектом Sheet через символ "."
            LastRowTarget = .Cells(.Rows.Count, "A").End(xlUp).Row ' Определение последней заполненной строки по столбцу A
            If LastRowTarget < FirstRow Then LastRowTarget = FirstRow  ' последняя заполненная строка не должна быть меньше FirstRow  (=2)
            .Rows(FirstRow & ":" & LastRowTarget).Clear    ' Удаление строк со старыми данными при новом распределении
        End With
    Next ShName
    With Worksheets("owssvr") ' Работа с объектом owssvr (программное имя объекта) через символ "."
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row  ' Определение последней заполненной строки по столбцу A
        A = .Range(.Cells(1, 1), .Cells(LastRow, 10)).Value ' Формируем массив для проверки условий
        For i = FirstRow To LastRow ' Цикл по строкам анализируемого листа
            If A(i, 7) <= Sheets("Формулы").Range("D5") And A(i, 7) >= Sheets("Формулы").Range("E7") Then ' Комплекс условий 1
                Set Sh_Target = Worksheets("1") ' Объектная ссылка на лист цель.
            ElseIf A(i, 7) >= Sheets("Формулы").Range("D5") And A(i, 7) <= Sheets("Формулы").Range("D2") Then ' Комплекс условий 2
                Set Sh_Target = Worksheets("2") ' Объектная ссылка на лист цель."
            ElseIf A(i, 7) >= Sheets("Формулы").Range("E2") And A(i, 7) <= Sheets("Формулы").Range("F2") Then ' Комплекс условий 3
                Set Sh_Target = Worksheets("3") ' Объектная ссылка на лист цель.
            End If
            .Range(.Cells(i, "A"), .Cells(i, "J")).Copy  ' копирование  i-той строки (по J,для последующей вставки форматов)
            With Sh_Target '  Работа с объектом листом-целью, куда копируем форматы, через символ "."
                 LastRowTarget = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 ' Определение последней пустой строки по столбцу A
                 If LastRowTarget < FirstRow Then LastRowTarget = FirstRow
                .Cells(LastRowTarget, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' вставка скопированных форматов
                .Rows(LastRowTarget).RowHeight = Sheets("owssvr").Rows(i).RowHeight ' Выравнивание высоты строки по исходной
            End With
        Next i
    End With
    Set Sh_Target = Nothing ' Очистка памяти от объектных ссылок
End Sub

if [условие1] and [условие2] Then' первая группа условий
   if [условие3] and [условие4] Then' если первая группа условий истинна то вторая группа условий
      'если первая и вторая группы условий истинны то набор операторов
 
   else 
      'если первая группа истинна, а вторая группа ложна то набор операторов
 
  end if
else
'если первая группа ложна то набор операторов
end if

            End With
            End If
            Set Sh_Target = Nothing
        Next i
    End With
    Set Sh_Target = Nothing ' Очистка памяти от объектных ссылок
End Sub