Как транспонировать длинный список групп строк в столбцы (с кодом/формулой)

Question

У меня есть данные, которые я хочу транспонировать, что должно быть достаточно просто. Однако, мне нужно транспонировать несколько строк в группах. Каждая последняя строка в каждой группе содержит определенный ТЕКСТ, поэтому я не знаю, есть ли способ создать диапазон для поиска текста вместо диапазона? (Это сработает? =if(isnumber(search(“TEXT”,A1)). Я пробовал создать макрос, но, очевидно, мне нужен код для транспонирования данных вниз по таблице, а не одних и тех же данных снова и снова. Любая помощь была бы здоровой!

Вот наглядное представление того, что мне нужно (так как я не могу его отформатировать, оно выглядит забавно, а поскольку я новичок, я не могу его встроить, поэтому я включил ссылку на наглядное представление того, как выглядят/должны выглядеть строки/столбцы):

Из этого:

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

К этому:

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

Вот код цикла, который я нашел:

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

Допустим, мы начнем с:

и мы хотим реорганизовать в строки, где последний элемент в каждой строке будетНовый. Этот код:

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

будет производить: