Moolex

Sub Copyrows()

'ListRes = "Лист1"
ListRes = "Фильтр"

LastRow1 = Sheets("Отчет ДЗО").Cells(Rows.Count, 1).End(xlUp).Row
LastRow2 = Sheets(ListRes).Cells(Rows.Count, 1).End(xlUp).Row

dzo = ""

b = LastRow2 + 1

For a = 1 To LastRow1
  a1 = Sheets("Отчет ДЗО").Cells(a, 1).Value
  a2 = Sheets("Отчет ДЗО").Cells(a, 2).Value
  a3 = Sheets("Отчет ДЗО").Cells(a, 3).Value
  
  If (a1 <> "") Then
    If (a2 <> "") And (a3 <> "Количество незащищенных устройств") Then
        Sheets(ListRes).Cells(b, 1).Value = dzo
        Sheets(ListRes).Cells(b, 2).Value = a2
        Sheets(ListRes).Cells(b, 3).Value = a3
        Sheets(ListRes).Cells(b, 4).Value = Now
        
        b = b + 1
    Else
       If (a2 = "") And (a3 = "") Then
        dzo = Replace(a1, "_Сервера администрирования : ", "")
       End If
    End If
    
  End If
Next
End Sub

ЛЕВСИМВ(RC[-4];4)
ПРАВСИМВ(RC[-4];ДЛСТР(RC[-4])-4)