Snasui Excel Forum

Code: Select all

Sub Test0()
    Dim rAll As Range, r As Range
    Dim rngForLoop As Range, rngLoop As Range
    Dim c As Integer, l As Integer, k As Integer
    Dim n As Integer, m As Integer, o As Integer
    Dim arr(9999, 176) As Variant
    With Worksheets("Sheet1")
        Set rAll = .Range("fk6", .Range("fk" & .Rows.Count).End(xlUp))
        k = 0
        For Each r In rAll
            l = 0
            For iCol = 0 To .Range("fk5:kk5").Columns.Count Step 13
                Set rngForLoop = r.Offset(0, iCol).Resize(1, 12)
                c = 0
               For Each rngLoop In rngForLoop
                    n = m + c
                    For o = 0 To 164
                        arr(n, o) = .Cells(rngLoop.Row, 2).Offset(0, o).Value
                    Next o
                    arr(n, 165) = .Cells(5, rngLoop.Column).Value
                    arr(n, 166 + l) = rngLoop.Value
                    c = c + 1 'month col
                    k = k + 1 'all line
               Next rngLoop
               l = l + 1 'each range
            Next iCol
            m = m + 12 'month
        Next r
    End With
    With Sheets(3)
        .Range("b6").Resize(k, 177).Value = arr
    End With
End Sub