Hi

try

Code:
Sub kTest()
    
    Dim k, ka(), i As Long, c As Long, n As Long
    
    With Sheet1
        .UsedRange.Replace "0", vbNullString, 1
        k = .Range("a1").CurrentRegion.Value2
    End With
    
    ReDim ka(1 To UBound(k, 1) * UBound(k, 2), 1 To 3)
    
    For c = 3 To UBound(k, 2)
        For i = 2 To UBound(k, 1)
            If Len(k(i, c)) Then
                n = n + 1
                ka(n, 1) = k(i, 1)
                ka(n, 2) = k(i, c)
                ka(n, 3) = k(i, 2)
            End If
        Next
    Next
    If n Then
        Sheet2.Range("e2").Resize(n, UBound(ka, 2)) = ka
        Sheet2.Range("e1").Resize(, UBound(ka, 2)) = [{"Loc","Total","Reg"}]
    End If
End Sub