Sub макрос_шмакрос()
Dim a(), b()
Dim i&, j&
'берём в массив "a" диапазон B1:B+номер последней заполненной ячейки
a = Range("B1:E" & Cells(Rows.Count, 2).End(xlUp).Row).Value
ReDim b(1 To UBound(a), 1 To 4) 'перезаписываем массив "b"
j = 1 'номер первого элемента массива "b"
For i = 1 To UBound(a) 'проходим циклом по массиву "a"
      If IsDate(a(i, 1)) Then 'если элемент в первой колонке дата то
          If j = 1 Then GoTo stuff 'если это первый элемент массива "b" то
          'пропускаем сравнение значений в 4й колонке (дубликаты, не с чем сравнивать)
          'идём к строкам после "stuff:"
          'если текущее значение из массива "а" не равно предыдущему значению из массива "b" то
          If a(i, 4) <> b(j - 1, 4) Then
stuff:
              b(j, 1) = a(i, 1) 'заносим значения из одного массива в другой
              b(j, 2) = a(i, 2)
              b(j, 3) = a(i, 3)
              b(j, 4) = a(i, 4)
              j = j + 1 'увеличиваем счётчик "строк" массива "b"
          End If
      End If
Next
Range("K1").Resize(UBound(b), 4) = b 'выгружаем массив "b" на лист, начиная с "К1"
End Sub