Guru do Excel e Power BI

Sub RearranjaDados()
 Dim a As Range, x As Long, v As Long, n As Long
  Application.ScreenUpdating = False
  Columns("I:L").Clear
  For Each a In Columns(1).SpecialCells(2).Areas
   If a.Cells(1) Like "*sequencial*" Then
    Cells(a.Row, 9).Resize(, 4).Value = a.Cells(1).Resize(, 4).Value
    x = a.Cells(1).End(4).Row
    Cells(a.Row + 1, 12).Resize(x - a.Row).Value = a.Cells(2, 4).Resize(x - a.Row).Value
    For n = a.Row + 1 To x
     Cells(n, 9).Resize(, 3).Value = Cells(n, 1).Resize(, 3).Value
     v = Application.CountIf(Cells(n, 1).Resize(x - a.Row), Cells(n, 1))
     Cells(n, 9).Resize(v).Merge: Cells(n, 10).Resize(v).Merge: Cells(n, 11).Resize(v).Merge
     n = n + v - 1
    Next n
   Else: Cells(a.Row, 9) = a.Cells(1)
   End If
  Next a
  Columns("I:L").HorizontalAlignment = xlCenter
  Columns("I:L").VerticalAlignment = xlCenter
  Application.ScreenUpdating = True
End Sub

Application.DisplayAlerts = False
     With ActiveSheet
        For i = .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1).Row To 2 Step -1
 
        If i > 2 Then
            If .Cells(i, 4).Value = .Cells(i - 1, 4).Value And .Cells(i, 4) <> "" Then
               Range(.Cells(i, 4), .Cells(i - 1, 4)).Merge
         'colocar o restante das colunas
               
               End If

         End If
     Next i
     End With
    Application.DisplayAlerts = True