Como transpor uma longa lista de grupos de linhas em colunas (com código/fórmula)

Question

Tenho dados que quero transpor, o que deve ser bastante fácil. No entanto, há várias linhas que preciso transpor em grupos. Cada última linha de cada grupo contém um determinado TEXTO, então não sei se existe alguma maneira de criar um intervalo pesquisando texto em vez de um intervalo. (Isso funcionaria? =if(isnumber(search(“TEXT”,A1))Tentei criar uma macro, mas obviamente preciso do código para transpor os dados para a planilha e não os mesmos dados repetidamente. Qualquer ajuda seria ótima!

Aqui está um visual do que eu preciso (como não consigo formatá-lo, parece engraçado e, como sou novo, não consegui incorporá-lo, então incluí um link de um visual de como as linhas/colunas se parecem/deveriam parece:

A partir disso:

Column A
Row A1
Row A2
Row A3
Row A4
Row A5
Row A6
Row A7
Row A8
Row A9
Row A10
Row A11
Row A12
Row A13

Para isso:

Col A   Col B   Col C   Col D   Col E
Row A1  Row A2  Row A3  Row A4
Row A5  Row A6  Row A7  Row A8  Row A9
Row A10 Row A11 Row A12 Row A13

Aqui está o código de loop que encontrei:

Sub Test1()
'UpdatebyExtendoffice20161222
      Dim x As Integer
      Application.ScreenUpdating = False
      ' Set numrows = number of rows of data.
      NumRows = Range("A1", Range("A8”).End(xlDown)).Rows.Count
      ' Select cell a1.
      Range("A1").Select
      ' Establish "For" loop to loop "numrows" number of times.
      For x = 1 To NumRows
         ' Insert your code here.

         ' Selects cell down 7 row from active cell.
         ActiveCell.Offset(7, 0).Select
      Next
      Application.ScreenUpdating = True
End Sub

Answer 1

Digamos que começamos com:

e queremos reorganizar em linhas com o último item de cada linha sendoNovo. Este código:

Sub ReOrg()
    Dim i As Long, j As Long, N As Long, K As Long
    Dim kk As Long
    i = 1
    j = 2
    K = Cells(Rows.Count, "A").End(xlUp).Row

    For kk = 1 To K
        Cells(i, j).Value = Cells(kk, 1).Value
        j = j + 1
        If Cells(kk, 1).Value = "New" Then
            i = i + 1
            j = 2
        End If
    Next kk
End Sub

vai produzir: