Another macro for you to consider...
Code:
Sub RearrangeData()
  Dim Col As Long, LastRow As Long, OutRow As Long, RowCount As Long
  Dim WSdata As Worksheet, WSout As Worksheet
  Const StartRow As Long = 2
  Set WSdata = Worksheets("Sheet1")
  Set WSout = Worksheets("Sheet2")
  LastRow = WSdata.Cells(Rows.Count, "A").End(xlUp).Row
  RowCount = LastRow - StartRow + 1
  WSout.Range("A1:C1") = Array("Loc", "Total", "Reg")
  OutRow = 2
  For Col = 3 To 6  'Columns C thru F
    WSout.Cells(OutRow, "A").Resize(RowCount) = WSdata.Cells(StartRow, "A").Resize(RowCount).Value
    WSout.Cells(OutRow, "B").Resize(RowCount) = WSdata.Cells(StartRow, Col).Resize(RowCount).Value
    WSout.Cells(OutRow, "C").Resize(RowCount) = WSdata.Cells(StartRow, "B").Resize(RowCount).Value
    OutRow = OutRow + RowCount
  Next
  WSout.Columns("B").Replace 0, "", xlWhole
  On Error GoTo NoBlanks
  WSout.Columns("B").SpecialCells(xlBlanks).EntireRow.Delete
NoBlanks:
End Sub