Convert headers and row level data to column level - vba

Question

I have very little experience working with VBA, so I'm having a hard time looking up what I am trying to do because I am having a hard time putting what I am trying to do into words.
I have been struggling to write a code to do the below task for the past few days.
Basically what I am trying to do is to convert a set of data to different format.
This what my source data looks like.
Data:
and I need it to look like this
FinalLook:
I've a already setup a code which is lengthy and incomplete.
FIRST PART
I started with retrieving a part of a data (AQ:BA) and then convert to the format in sheet2 with the below code.
Sub FirstPart()
Dim lastRow As Long
Dim Laaastrow As Long
Sheets("sheet2").Range("a2:A5000").ClearContents
lastRow = Sheets("Sheet1").Range("c" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Range("A2:A" & lastRow).Value = Sheets("Sheet1").Range("c5:c" & lastRow).Value
Sheets("Sheet2").Range("b2:l" & lastRow).Value = Sheets("Sheet1").Range("aq5:ba" & lastRow).Value
End Sub
But.. the problem i am facing with this code is that it pulls all the data, i do not want it to pull all the values, but only the ones which is not empty or 0. In other words, if AQ6:BA6 is empty, script should skip this particular row and go the next one.
SECOND PART (converting the sheet2 data to the final format)
Sub NormalizeSheet()
Dim wsSheet2 As Worksheet
Dim wsSheet4 As Worksheet
Dim strKey As String
Dim clnHeader As Collection
Dim lngColumnCounter As Long
Dim lngRowCounterSheet2 As Long
Dim lngRowCounterSheet4 As Long
Dim rngCurrent As Range
Dim varColumn As Variant
Set wsSheet2 = ThisWorkbook.Worksheets("Sheet2")
Set wsSheet4 = ThisWorkbook.Worksheets("Sheet4")
Set clnHeader = New Collection
wsSheet4.Range("c2:c5000").ClearContents
wsSheet4.Range("e2:e5000").ClearContents
wsSheet4.Range("g2:g5000").ClearContents
lngColumnCounter = 2
lngRowCounterSheet2 = 1
Set rngCurrent = wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter)
Do Until IsEmpty(rngCurrent.Value)
clnHeader.Add rngCurrent.Value, CStr(lngColumnCounter)
lngColumnCounter = lngColumnCounter + 1
Set rngCurrent = wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter)
Loop
lngRowCounterSheet2 = 2
lngRowCounterSheet4 = 1
lngColumnCounter = 1
Do While Not IsEmpty(wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter))
Set rngCurrent = wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter)
strKey = rngCurrent.Value
lngColumnCounter = 2
Do While Not IsEmpty(wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter))
Set rngCurrent = wsSheet2.Cells(lngRowCounterSheet2, lngColumnCounter)
If rngCurrent.Value = "NULL" Then
Else
wsSheet4.Range("c" & lngRowCounterSheet4).Offset(1, 0).Value = strKey
wsSheet4.Range("e" & lngRowCounterSheet4).Offset(1, 0).Value = clnHeader(CStr(lngColumnCounter))
wsSheet4.Range("g" & lngRowCounterSheet4).Offset(1, 0).Value = rngCurrent.Value
lngRowCounterSheet4 = lngRowCounterSheet4 + 1
End If
lngColumnCounter = lngColumnCounter + 1
Loop
lngRowCounterSheet2 = lngRowCounterSheet2 + 1
lngColumnCounter = 1
Loop
End Sub
I got this code from another thread posted here on stakcoverflow, i modified a bit to get this work.
The problem i am encountering here is that if Sheet2 B2 is empty, the codes doesnt check sheet C2 instead it skips the whole row, which is not right here.
I know this sounds complicated, and this approach of mine may not be even feasible.
Is there ANY OTHER WAY to do this? Is there any other way to get this in a single shot instead of breaking down the data and move each set of columns to sheet2 then to final format?

Answer 1

See how you get on with this. You'll have to adjust range references, and possibly sheet names
Sub x()
Dim r As Long, c As Range
With Sheet1
For r = 5 To .Range("A" & Rows.Count).End(xlUp).Row
For Each c In .Range(.Cells(r, "AQ"), .Cells(r, "BK")).SpecialCells(xlCellTypeConstants)
If c.Value > 0 Then
Sheet2.Range("A" & Rows.Count).End(xlUp)(2).Value = .Range("B1").Value
Sheet2.Range("B" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 1).Value
Sheet2.Range("C" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 2).Value
Sheet2.Range("D" & Rows.Count).End(xlUp)(2).Value = .Cells(3, c.Column).Value
Sheet2.Range("E" & Rows.Count).End(xlUp)(2).Value = .Cells(4, c.Column).Value
Sheet2.Range("F" & Rows.Count).End(xlUp)(2).Value = "(blank)"
Sheet2.Range("G" & Rows.Count).End(xlUp)(2).Value = c.Value
End If
Next c
Next r
End With
Sheet2.Range("A1").Resize(, 7) = Array("TOPHEADER", "HEADER1", "HEADER2", "FROM", "TO", "TYPE", "UNIT")
End Sub