Convert Multiple Columns to Rows including blank cells

Hello BJPhil,

The macro below has been added to the attached workbook. If have any problems with it, let me know.
A button (Run) has also been been added to the worksheet to run the macro.

Sub Macro1()

  ' Thread: http://www.excelforum.com/excel-programming-vba-macros/1003920-convert-multiple-columns-to-rows-including-blank-cells.html
  
    Dim c       As Long
    Dim Data    As Variant
    Dim n       As Long
    Dim r       As Long
    Dim Rng     As Range
    Dim Who     As String
    Dim Wks     As Worksheet
    
        Set Wks = Worksheets("Sheet1")
        
        Set Rng = Wks.Range("A1").CurrentRegion
        
        n = (Wks.Cells(1, Columns.Count).End(xlToLeft).Column - 1) / 4

            r = Rng.Rows.Count - 1
            ReDim Data(1 To (r * n), 1 To 5)
            n = 1
            
                For r = 2 To Rng.Rows.Count
                    Who = Rng.Cells(r, 1)
                    
                    For c = 2 To Rng.Columns.Count Step 4
                        Data(n, 2) = Rng.Cells(r, c + 0)
                        Data(n, 3) = Rng.Cells(r, c + 1)
                        Data(n, 4) = Rng.Cells(r, c + 2)
                        Data(n, 5) = Rng.Cells(r, c + 3)
                        
                        x = Application.Match("*", Array(Data(n, 2), Data(n, 3), Data(n, 4), Data(n, 5)), 0)
                        If Not IsError(x) Then
                            Data(n, 1) = Who
                            n = n + 1
                        End If
                    Next c
                Next r
                
            Wks.Range("A11:D11").Resize(UBound(Data), 5).Value = Data
            
End Sub