Autofill based on dynamic row - vba

Question

I'm trying to figure out how to start an autofill based on a dynamic range. For each column in the 'starting table' I need to stack them on top of one another. My current code starting at 'LastRow' does not do this. I was hoping LastRow would give me a dynamic Range to autofill from, but instead I get the error,
'Object variable or With block variable not set'
How do I change my code so that '2Move' autofills to the new size of the table, without knowing where it starts? Then repeat the process for '3Move' and '4Move'
Sub shiftingColumns()
Dim sht As Worksheet
Dim LastRow As Range
Set sht = ActiveSheet
Set copyRange = Sheets("Sheet1").Range(Range("A2:B2"), Range("A2:B2").End(xlDown))
'Insert column & add header
Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Value = "Category"
'Move D1 Value to C2
Range("D1").Cut Destination:=Range("C2")
'Autofill C2 value to current table size
Range("C2").AutoFill Destination:=Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row)
'Copy copyRange below itself
copyRange.Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
'Move E1 below autofilled ranged
Range("E1").Cut Destination:=Range("C" & Rows.Count).End(xlUp).Offset(1)
'LastRow = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row
'LastRow.AutoFill Destination:=Range(LastRow & Range("A" & Rows.Count).End(xlUp).Row)
End Sub
This is the starting table
This is the desired table

Answer 1

For the benefit of those finding this via search engine, what you're looking to do isn't anything like autofill.
This should work for you, a loop.
Sub test()
workingSheet = ActiveSheet.Name
newSheet = "New Sheet"
On Error Resume Next
Application.DisplayAlerts = False
Sheets(newSheet).Delete
Application.DisplayAlerts = True
Sheets.Add.Name = newSheet
Cells(1, 1) = "ID"
Cells(1, 2) = "Color"
Cells(1, 3) = "Category"
On Error GoTo 0
Sheets(workingSheet).Activate
'Get last column
x = Cells(1, 3).End(xlToRight).Column
y = Cells(1, 1).End(xlDown).Row
'Loop for each column from 3 (column "C") and after
For i = 3 To x
With Sheets(newSheet)
newRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
'Copy ID and Color
Range(Cells(2, 1), Cells(y, 2)).Copy .Range(.Cells(newRow, 1), .Cells(newRow + y, 2))
'Copy column header
.Range(.Cells(newRow, 3), .Cells(newRow + (y - 2), 3)) = Cells(1, i)
'Copy column values
Range(Cells(2, i), Cells(y, i)).Copy .Range(.Cells(newRow, 4), .Cells(newRow + y, 4))
End With
Next
End Sub
If your demands vary, such as adding other "fixed" columns like ID and Color then you'll have to change the cell addressing and such.

Answer 2

These two method will transpose the data much faster than Range.Copy and Range.Paste.
PivotTableValues - dumps the Range.Value into an array, data, then fills a second array, results, with the transposed values. Note: Transposed in this context simply means moved to a different place.
PivotTableValues2 - uses Arraylists to accomplish the OP's goals. Although it works great, it is somewhat a farcical answer. I just wanted to try this approach for esoteric reasons.
PivotTableValues Using Arrays
Sub PivotTableValues()
Const FIXED_COLUMN_COUNT As Long = 2
Dim ArrayRowCount As Long, Count As Long, ColumnCount As Long, RowCount As Long, x As Long, y As Long, y2 As Long
Dim data As Variant, results As Variant, v As Variant
With ThisWorkbook.Worksheets("Sheet1")
RowCount = .Range("A" & .Rows.Count).End(xlUp).Row
ColumnCount = .Cells(1, .Columns.Count).End(xlToLeft).Column
data = Range(.Range("A" & .Rows.Count).End(xlUp), .Cells(1, .Columns.Count).End(xlToLeft)).Value
ArrayRowCount = (ColumnCount - FIXED_COLUMN_COUNT) * (RowCount - 1) + 1
ReDim results(1 To ArrayRowCount, 1 To FIXED_COLUMN_COUNT + 2)
Count = 1
For y = FIXED_COLUMN_COUNT + 1 To ColumnCount
For x = 2 To RowCount
Count = Count + 1
results(Count, FIXED_COLUMN_COUNT + 1) = data(1, y)
results(Count, FIXED_COLUMN_COUNT + 2) = data(x, y)
For y2 = 1 To FIXED_COLUMN_COUNT
If Count = 2 Then
results(1, y2) = data(1, y2)
results(1, y2 + 1) = "Category"
results(1, y2 + 2) = "Value"
End If
results(Count, y2) = data(x, y2)
Next
Next
Next
End With
With ThisWorkbook.Worksheets.Add
.Range("A1").Resize(UBound(results), UBound(results, 2)).Value = results
.Columns.AutoFit
End With
End Sub
PivotTableValues2 Using ArrayLists
Sub PivotTableValues2()
Const FIXED_COLUMN_COUNT As Long = 2
Dim ColumnCount As Long, RowCount As Long, x As Long, y As Long
Dim valueList As Object, baseList As Object, results As Variant, v As Variant
Set valueList = CreateObject("System.Collections.ArrayList")
Set baseList = CreateObject("System.Collections.ArrayList")
With ThisWorkbook.Worksheets("Sheet1")
RowCount = .Range("A" & .Rows.Count).End(xlUp).Row
ColumnCount = .Cells(1, .Columns.Count).End(xlToLeft).Column
For x = 1 To RowCount
baseList.Add Application.Transpose(Application.Transpose(Range(.Cells(x, 1), .Cells(x, FIXED_COLUMN_COUNT))))
Next
For y = FIXED_COLUMN_COUNT + 2 To ColumnCount
baseList.AddRange baseList.getRange(1, RowCount - 1)
Next
For y = FIXED_COLUMN_COUNT + 1 To ColumnCount
For x = 2 To RowCount
valueList.Add Array(.Cells(1, y).Value, .Cells(x, y).Value)
Next
Next
End With
results = Application.Transpose(Application.Transpose(baseList.ToArray))
With ThisWorkbook.Worksheets.Add
.Range("A1").Resize(UBound(results), UBound(results, 2)).Value = results
valueList.Insert 0, Array("Category", "Value")
results = Application.Transpose(Application.Transpose(valueList.ToArray))
.Cells(1, FIXED_COLUMN_COUNT + 1).Resize(UBound(results), UBound(results, 2)).Value = results
.Columns.AutoFit
End With
End Sub