関数式でしたらありがたいです｡

以下のﾏｸﾛをお試しください｡

最初に変数を設定しておく必要があります｡
左上部のIDがあるｾﾙはidに､
左ﾘｽﾄのﾀｲﾄﾙ行がある列番号をcol0に､行番号をrow0に
集計先のﾀｲﾄﾙ行がある列番号をcol1に､行番号をrow1に
それぞれ設定してください｡

Option Explicit

Sub main()
 Dim sheet As String
 Dim col0 As Long, row0 As Long, col1 As Long, row1 As Long
 Dim id As Integer, i As Integer, j As Integer, k As Integer
 Dim items(10) As Integer

 sheet = "Sheet1"  'ｼｰﾄ名
 Worksheets(sheet).Select
 
 id = Cells(2, 2)  'ID番号のあるｾﾙ(この例では2行目のB列)
 col0 = 1  '読み取り元の表ﾀｲﾄﾙのある列番号(A列なら1)
 row0 = 4  '読み取り元の表ﾀｲﾄﾙのある行番号(4行目なら4)
 col1 = 7  'ｺﾋﾟｰ先の表ﾀｲﾄﾙのある列番号(G列なら7)
 row1 = 4  'ｺﾋﾟｰ先の表ﾀｲﾄﾙのある行番号(4行目なら4)

  'ﾀｲﾄﾙ行のｺﾋﾟｰ
 For i = 0 To 4
 Cells(row1, col1 + i).Value = Cells(row0, col0 + i).Value
 Next i
 
  '集計
 row0 = row0 + 1
 row1 = row1 + 1
 While (Cells(row0, col0).Value <> "" And IsNumeric(Cells(row0, col0).Value))
 i = Cells(row0, col0).Value
 If (i = id) Then
 If (Cells(row0, col0 + 1).Value = 0) Then
 For j = 0 To 2
 For k = 0 To 2
 items(j * 3 + k) = items(j * 3 + k) + Cells(row0 + j, col0 + 2 + k).Value
 Next k
 Next j
 End If
 End If
 row0 = row0 + 3
 Wend

  '結果の書き込み
 Cells(row1, col1).Value = id
 Cells(row1, col1 + 1).Value = 0
 For j = 0 To 8
 Cells(row1 + j \ 3, col1 + 2 + j Mod 3).Value = items(j)
 Next j
End Sub

Sub idset()

 Dim a As Long
 
 ID入力位置行 = 2
 ID入力位置列 = 2
 
  'ﾃﾞｰﾀがある行から指定(見出しは のぞく)
 左ID開始行 = 5
 左ID開始列 = 1
 
 右ID開始行 = 5
 右ID開始列 = 7
 
 b = Cells(ID入力位置行, ID入力位置列)
 
 f = 0
 For a = 左ID開始行 To Rows.Count Step 3
 If Cells(a, 左ID開始列) = "" Then Exit For
 
 If Cells(a, 左ID開始列) = b And Cells(a, 左ID開始列 + 1) = 0 Then
 If f = 0 Then
 Cells(右ID開始行, 右ID開始列) = Cells(a, 左ID開始列)
 Cells(右ID開始行, 右ID開始列 + 1) = Cells(a, 左ID開始列 + 1)
 
 Cells(右ID開始行, 右ID開始列 + 2) = Cells(a, 左ID開始列 + 2)
 Cells(右ID開始行, 右ID開始列 + 3) = Cells(a, 左ID開始列 + 3)
 Cells(右ID開始行, 右ID開始列 + 4) = Cells(a, 左ID開始列 + 4)
 
 Cells(右ID開始行 + 1, 右ID開始列 + 2) = Cells(a + 1, 左ID開始列 + 2)
 Cells(右ID開始行 + 1, 右ID開始列 + 3) = Cells(a + 1, 左ID開始列 + 3)
 Cells(右ID開始行 + 1, 右ID開始列 + 4) = Cells(a + 1, 左ID開始列 + 4)
 
 Cells(右ID開始行 + 2, 右ID開始列 + 2) = Cells(a + 2, 左ID開始列 + 2)
 Cells(右ID開始行 + 2, 右ID開始列 + 3) = Cells(a + 2, 左ID開始列 + 3)
 Cells(右ID開始行 + 2, 右ID開始列 + 4) = Cells(a + 2, 左ID開始列 + 4)
 f = 1
 Else
 Cells(右ID開始行, 右ID開始列 + 2) = Cells(a, 左ID開始列 + 2) + Cells(右ID開始行, 右ID開始列 + 2)
 Cells(右ID開始行, 右ID開始列 + 3) = Cells(a, 左ID開始列 + 3) + Cells(右ID開始行, 右ID開始列 + 3)
 Cells(右ID開始行, 右ID開始列 + 4) = Cells(a, 左ID開始列 + 4) + Cells(右ID開始行, 右ID開始列 + 4)
 
 Cells(右ID開始行 + 1, 右ID開始列 + 2) = Cells(a + 1, 左ID開始列 + 2) + Cells(右ID開始行 + 1, 右ID開始列 + 2)
 Cells(右ID開始行 + 1, 右ID開始列 + 3) = Cells(a + 1, 左ID開始列 + 3) + Cells(右ID開始行 + 1, 右ID開始列 + 3)
 Cells(右ID開始行 + 1, 右ID開始列 + 4) = Cells(a + 1, 左ID開始列 + 4) + Cells(右ID開始行 + 1, 右ID開始列 + 4)
 
 Cells(右ID開始行 + 2, 右ID開始列 + 2) = Cells(a + 2, 左ID開始列 + 2) + Cells(右ID開始行 + 2, 右ID開始列 + 2)
 Cells(右ID開始行 + 2, 右ID開始列 + 3) = Cells(a + 2, 左ID開始列 + 3) + Cells(右ID開始行 + 2, 右ID開始列 + 3)
 Cells(右ID開始行 + 2, 右ID開始列 + 4) = Cells(a + 2, 左ID開始列 + 4) + Cells(右ID開始行 + 2, 右ID開始列 + 4)
 End If
 End If
 Next a

End Sub

ｾﾙの位置は 最初にｾｯﾄしている箇所で変更してください｡

とりあえず IDを入力する箇所を B2とし､それを基準に それぞれ割り当ててます｡

ﾏｸﾛは この表のあるｼｰﾄに記述してください｡