Dim c1 As Range, c2 As Range 'задаем переменные куда будем копировать найденные адреса
Dim i, i1 As Integer
    For i = 1 To 1000  'задаем диапазон поиска в столбце
      If Cells(i, 2) Like "умвд" Then 'ищем ячейку со своим значением
       'MsgBox Cells(i, 1).Address
       Set c1 = Cells(i, 2) 'запоминаем найденую ячейку
       For i1 = 1 To 6 'задаем диапазон поиска в столбце
         If Len(Cells(c1.Row + i1, 2)) Then 'проверяем ячейки на содержание записей
         'MsgBox Cells(c1.Row + i1, 1).Address
          Else
          Set c2 = Cells(c1.Row + i1, 2) 'запоминаем пустую ячейку
          ' MsgBox "пусто" & Cells(c1.Row + i1, 1).Address
          lLastRow = Cells(Rows.Count, 4).End(xlUp).Row 'определяем строку полседней зянятой ячейки в столбце
          Range(c1.Address, c2.Address).Copy Range("d" & lLastRow + 2) 'копируем область между с1 и с2 в последнуюю занятую ячейку столбца D
          Exit For 'Выходим из цикла если найдена пустай ячейка
          End If 'Выходим из уловия по проверки зянятой ячейки
        Next 'если пустая ячейка не найдена продолжаем цикл
      End If 'Выходим из поиска если искомого значения
    Next 'продолжаем посик искомого значения
End Sub