excel - Looping through an array while grabbing certain elements -

i have giant dataset looks this

i trying go down list of different companies , grab 3 per company , combine them. based on photo above, have 2 different lists 3 companies each (except th repair have 2 in final list).

my real dataset contains hundreds of different companies, each dozens/hundreds of entries finish dozens of lists (each potentially hundreds long).

i tried record macro , ended code

sub loop1() ' ' loop1 macro '  '     range("a4:e6").select     selection.copy     sheets("sheet3").select     range("a18").select     activesheet.paste     sheets("sheet2").select     range("a11:e13").select     application.cutcopymode = false     selection.copy     sheets("sheet3").select     range("a21").select     activesheet.paste     sheets("sheet2").select     range("a17:e19").select     application.cutcopymode = false     selection.copy     sheets("sheet3").select     range("a24").select     activesheet.paste end sub 

however, turned out way more complicated expected.

i looking end result this

see if works you. ran 1 scenario through want test more.

• this makes assumption data sorted column b on original sheet
• this procedure makes assumption there either headers or no data on row 1.

• you need change "sheet1" in line set ws1 = activeworkbook.worksheets("sheet1") name of sheet starting with.

  option explicit  public sub movedata()      dim ws1 worksheet     set ws1 = activeworkbook.worksheets("sheet1")      dim ws2 worksheet     set ws2 = activeworkbook.worksheets.add()       dim rw long     dim match_count integer     dim list_multiplier integer     list_multiplier = 7     dim list_row() long     redim list_row(0)     list_row(0) = 2      rw = 2 ws1.range("a" & ws1.rows.count).end(xlup).row           if ws1.range("b" & rw).value <> ws1.range("b" & rw).offset(-1, 0).value             match_count = 0         else             match_count = match_count + 1         end if          dim list_num integer         list_num = match_count \ 3          if list_num > ubound(list_row, 1)             redim preserve list_row(list_num)             list_row(list_num) = 2         end if          ws2.cells(list_row(list_num), 1 + list_multiplier * list_num).value = ws1.range("a" & rw).value         ws2.cells(list_row(list_num), 2 + list_multiplier * list_num).value = ws1.range("b" & rw).value         ws2.cells(list_row(list_num), 3 + list_multiplier * list_num).value = ws1.range("c" & rw).value         ws2.cells(list_row(list_num), 4 + list_multiplier * list_num).value = ws1.range("d" & rw).value         ws2.cells(list_row(list_num), 5 + list_multiplier * list_num).value = ws1.range("e" & rw).value         list_row(list_num) = list_row(list_num) + 1      next rw  end sub