Excel VBA - Writing data to Array doesn't work

There are a few issues with your code (do watch out for those unqualified Ranges), but the main one is that you're getting your array indexes mixed up with the cell row and column references, and as you point out, there are a few pieces of redundant code where you dimension your array. Redim Preserve is also limited when you use multi-dimensional arrays.

So, immediately below is a modified version of your code which shows the required adjustments.

However, if you want to work with arrays, then you can be much more efficient. For example, you can read ranges into arrays and write from arrays to ranges in just one line of code (which is way faster than using loops). The second piece of code shows you a more efficient way of handling the task - I wasn't sure if your sample rows will all have "Details' in column "A", because if they do without interruption, then the code could be even shorter.

Your modified code:

Dim dataWs As Worksheet, newWs As Worksheet
Dim lastRow As Long, lastCol As Long
Dim c As Long, r As Long, i As Long, j As Long
Dim arr() As Variant

'Read the data into an array
Set dataWs = ThisWorkbook.Worksheets("Budget to Table")
With dataWs
    lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

'Loop through each of the data columns.
For c = 3 To lastCol
    If Not IsEmpty(dataWs.Cells(3, c)) Then 'looks lik you only want the yellow columns.
        'Dimension the array for number of rows
        ReDim arr(1 To lastRow - 4, 1 To 5)
        'Loop through each row in data array and transfer it.
        With dataWs
            For r = 5 To lastRow
                arr(r - 4, 1) = .Cells(r, 2).Value
                arr(r - 4, 2) = .Cells(r, c).Value
                arr(r - 4, 3) = .Cells(1, c).Value
                arr(r - 4, 4) = .Cells(2, c).Value
                arr(r - 4, 5) = .Cells(3, c).Value
            Next
        End With
        'Create a new sheet.
        With ThisWorkbook.Worksheets
            Set newWs = .Add(After:=.Item(.Count))
            newWs.Name = arr(1, 5) 'name it for ease of use.
        End With
        'Write array onto the new sheet - the inefficient way
        For i = 1 To UBound(arr, 1)
            For j = 1 To UBound(arr, 2)
                newWs.Cells(i, j).Value = arr(i, j)
            Next
        Next
    End If
Next

A different way of handling arrays:

Dim ws As Worksheet
Dim data As Variant, output() As Variant
Dim rowList As Collection
Dim c As Long, i As Long
Dim r As Variant

'Read the data into an array
With ThisWorkbook.Worksheets("Budget to Table")
    data = .Range(.Range("A1"), _
           .Range(.Cells(1, .Columns.Count).End(xlToLeft), _
                  .Cells(.Rows.Count, "B").End(xlUp))) _
           .Value2
End With

'Find the first dimension indexes with "Detail" in column A.
'We'll create a collection of our target row numbers.
Set rowList = New Collection
For i = 1 To UBound(data, 1)
    If data(i, 1) = "Detail" Then rowList.Add i
Next

'Loop through each of the data columns.
For c = 3 To UBound(data, 2)
    If Not IsEmpty(data(3, c)) Then 'looks lik you only want the yellow columns.
        'Dimension the array for number of rows
        ReDim output(1 To rowList.Count, 1 To 5)
        i = 1 'row index for output array
        'Loop through each row in data array and transfer it.
        For Each r In rowList
            output(i, 1) = data(r, 2)
            output(i, 2) = data(r, c)
            output(i, 3) = data(1, c)
            output(i, 4) = data(2, c)
            output(i, 5) = data(3, c)
            i = i + 1
        Next
        'Create a new sheet.
        With ThisWorkbook.Worksheets
            Set ws = .Add(After:=.Item(.Count))
            ws.Name = output(1, 5) 'name it for ease of use.
        End With
        'Write array onto the new sheet.
        ws.Range("A1").Resize(UBound(output, 1), UBound(output, 2)).Value = output
    End If
Next