Excel VBA 迴圈抓取每三欄轉置成多筆資料 用array寫出

Sub LoopThroughRowsByRefBom()
LastRow = Range("A" & Rows.Count).End(xlUp).Row
FirstRow = 1
i = FirstRow
FirstColumn = 1
Do Until i > LastRow
    LastColumn = Cells(i, Columns.Count).End(xlToLeft).Column
    j = FirstColumn
    Do Until j > LastColumn
        If i Mod 15 = 1 And j Mod 3 = 1 Then
            For k = 0 To 10
               Cells(i + k, j + 2).Value = Cells(i, j)
            Next k
        End If
        j = j + 3
    Loop
    i = i + 15
Loop

 Dim dynArray(1 To 5000, 1 To 4) As String
 i = 1
  k = 1
 Do Until i > LastRow
     LastColumn = Cells(i, Columns.Count).End(xlToLeft).Column
    j = 1
    Do Until j > LastColumn
        If j Mod 3 = 1 And i Mod 15 <= 10 And Not IsEmpty(Cells(i, j + 1).Value) And Cells(i, j + 1).Value > 0 Then
            dynArray(k, 1) = Cells(i, j + 2)
            dynArray(k, 2) = Cells((i \ 15) * 15 + 12, j + 1)
            dynArray(k, 3) = Cells(i, j)
            dynArray(k, 4) = Cells(i, j + 1)
             k = k + 1
        End If
        j = j + 3
    Loop
  i = i + 1
Loop

Dim De1 As Range
Set De1 = Range("AK1")
De1.Resize(UBound(dynArray, 1), UBound(dynArray, 2)).Value = dynArray
End Sub