Transpose VBA Excel Macro - excel

Question

I'm required to upload excel B to SQL database. But the users only managed to provide the format in excel A due to some reasons. Therefore, I need a transpose method to convert excel A into excel B so that my upload can be done.
Here are the format for excel A and B.
Excel A (user provided)
AREA CATEGORY 202033 202034 202035 202036
WET FISH 33 34 35 36
WET CHICKEN 36 35 34 33
DRY VEGETABLES 34 28 24 24
Excel B (required format to upload to SQL database)
AREA CATEGORY WEEK SALES
WET FISH 202033 33
WET FISH 202034 34
WET FISH 202035 35
WET FISH 202036 36
WET CHICKEN 202033 36
WET CHICKEN 202034 35
WET CHICKEN 202035 34
WET CHICKEN 202036 33
DRY VEGETABLES 202033 34
DRY VEGETABLES 202034 28
DRY VEGETABLES 202035 24
DRY VEGETABLES 202036 24
I'm totally new to VBA excel macro but I need to get this completed. Anyone can guide me?

Answer 1

I shouldn't answer this post because there the OP has provided no coding examples. But the OP did make an effort to write an otherwise good post and I'm quite bored.
Sub ConvertUserData()
Const SourceWorksheetName As String = "Sheet1"
Const HeaderColumnCount As Long = 2
Dim Data As Variant
Data = Worksheets(SourceWorksheetName).Range("A1").CurrentRegion
Dim RowCount As Long
RowCount = (UBound(Data, 2) - HeaderColumnCount) * (UBound(Data) - 1)
Dim Results() As Variant
ReDim Results(1 To RowCount, 1 To 4)
Dim Row As Long
Dim Column As Long
Dim n As Long
For Row = 2 To UBound(Data)
For Column = HeaderColumnCount + 1 To UBound(Data, 2)
n = n + 1
Results(n, 1) = Data(Row, 1)
Results(n, 2) = Data(Row, 2)
Results(n, 3) = Data(1, Column)
Results(n, 4) = Data(Row, Column)
Next
Next
With Workbooks.Add
With Worksheets(1)
.Range("A1:D1").Value = Array("AREA", "CATEGORY", "WEEK", "SALES")
.Range("A2").Resize(RowCount, 4) = Results
End With
End With
End Sub

Answer 2

Try,
Sub test()
Dim vDB, vR()
Dim Ws As Worksheet
Dim toWs As Worksheet
Dim i As Long, r As Long, n As Long
Dim j As Integer, c As Integer
Set Ws = ActiveSheet 'set your Orginal data sheet
Set toWs = Sheets(2) 'set Result sheet
vDB = Ws.Range("a1").CurrentRegion
r = UBound(vDB, 1)
c = UBound(vDB, 2)
For i = 2 To r
For j = 3 To c
If vDB(i, j) <> "" Then
n = n + 1
ReDim Preserve vR(1 To 4, 1 To n)
vR(1, n) = vDB(i, 1)
vR(2, n) = vDB(i, 2)
vR(3, n) = vDB(1, j)
vR(4, n) = vDB(i, j)
End If
Next j
Next i
With toWs
.UsedRange.Clear
.Range("a1").Resize(1, 4) = Array("AREA", "CATEGORY", "WEEK", "SALES")
.Range("a2").Resize(n, 4) = WorksheetFunction.Transpose(vR)
End With
End Sub