How to “flatten” or “collapse” a 2D Excel table into 1D?

Question

I have a two dimensional table with countries and years in Excel. eg.

        1961        1962        1963        1964
USA      a           x            g           


        

Answer 1

Code with the claim for some universality The book should have two sheets: Sour = Source data Dest = the "extended" table will drop here

    Option Explicit
    Private ws_Sour As Worksheet, ws_Dest As Worksheet
    Private arr_2d_Sour() As Variant, arr_2d_Dest() As Variant
    ' https://stackoverflow.com/questions/52594461/find-next-available-value-in-excel-cell-based-on-criteria
    Public Sub PullOut(Optional ByVal msg As Variant)
        ws_Dest_Acr _
                arr_2d_ws( _
                arr_2d_Dest_Fill( _
                arr_2d_Sour_Load( _
                arr_2d_Dest_Create( _
                CountA_rng( _
                rng_2d_For_CountA( _
                Init))))))
    End Sub

    Private Function ws_Dest_Acr(Optional ByVal msg As Variant) As Variant
        ws_Dest.Activate
    End Function

    Public Function arr_2d_ws(Optional ByVal msg As Variant) As Variant
        If IsArray(arr_2d_Dest) Then _
           ws_Dest.Cells(1, 1).Resize(UBound(arr_2d_Dest), UBound(arr_2d_Dest, 2)) = arr_2d_Dest
    End Function

    Private Function arr_2d_Dest_Fill(Optional ByVal msg As Variant) As Variant
        Dim y_Sour As Long, y_Dest As Long, x As Long
        y_Dest = 1
        For y_Sour = LBound(arr_2d_Sour) To UBound(arr_2d_Sour)
            ' without the first column
            For x = LBound(arr_2d_Sour, 2) + 1 To UBound(arr_2d_Sour, 2)
                If arr_2d_Sour(y_Sour, x) <> Empty Then
                    arr_2d_Dest(y_Dest, 1) = arr_2d_Sour(y_Sour, 1)    'iD
                    arr_2d_Dest(y_Dest, 2) = arr_2d_Sour(y_Sour, x)    'DTLx
                    y_Dest = y_Dest + 1
                End If
            Next
        Next
    End Function

    Private Function arr_2d_Sour_Load(Optional ByVal msg As Variant) As Variant
        arr_2d_Sour = ReDuce_rng(ws_Sour.UsedRange, 1, 0).Offset(1, 0).Value
    End Function

    Private Function arr_2d_Dest_Create(ByVal iRows As Long)
        Dim arr_2d() As Variant
        ReDim arr_2d(1 To iRows, 1 To 2)
        arr_2d_Dest = arr_2d
        arr_2d_Dest_Create = arr_2d
    End Function

    Public Function CountA_rng(ByVal rng As Range) As Double
        CountA_rng = Application.WorksheetFunction.CountA(rng)
    End Function

    Private Function rng_2d_For_CountA(Optional ByVal msg As Variant) As Range
        ' without the first line and without the left column
        Set rng_2d_For_CountA = _
        ReDuce_rng(ws_Sour.UsedRange, 1, 1).Offset(1, 1)
    End Function

    Public Function ReDuce_rng(rng As Range, ByVal iRow As Long, ByVal iCol As Long) _
           As Range
        With rng
            Set ReDuce_rng = .Resize(.Rows.Count - iRow, .Columns.Count - iCol)
        End With
    End Function

    Private Function Init()
        With ThisWorkbook
            Set ws_Sour = .Worksheets("Sour")
            Set ws_Dest = .Worksheets("Dest")
        End With
    End Function

'https://youtu.be/oTp4aSWPKO0