Скрипт по переносу данных с одного листа Excel на другой
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
Функции для строки в Excel на заметку
ЛЕВСИМВ(RC[-4];4) ПРАВСИМВ(RC[-4];ДЛСТР(RC[-4])-4)