Samle flere kolonner i en lang kolonne

Public Sub Samle_i_Kolonne()
    Dim Data As Variant, ResData() As Variant, N As Long, i As Long, X As Long
    N = 0
    Data = Range("a1").CurrentRegion
    ReDim ResData(UBound(Data, 1) * UBound(Data, 2))
    For i = 1 To UBound(Data, 2)
        For X = 1 To UBound(Data, 1)
            If Not IsEmpty(Data(X, i)) Then
                ResData(N) = Data(X, i)
                N = N + 1
            End If
        Next
    Next
    Range("a1").CurrentRegion.ClearContents
    Range("A1:A" & UBound(ResData) + 1) = Application.WorksheetFunction.Transpose(ResData)
End Sub


Husk at tage kopi inden

Det er bare super. Kan den også lade være med at inkludere overskrifterne i den nye tabel (gh, hgt, fd og sd)?

Public Sub Samle_i_Kolonne()
    Dim Data As Variant, ResData() As Variant, N As Long, i As Long, X As Long
    N = 0
    Data = Range("a1").CurrentRegion
    ReDim ResData(UBound(Data, 1) * UBound(Data, 2))
    For i = 1 To UBound(Data, 2)
        For X = 2 To UBound(Data, 1)
            If Not IsEmpty(Data(X, i)) Then
                ResData(N) = Data(X, i)
                N = N + 1
            End If
        Next
    Next
    Range("a1").CurrentRegion.ClearContents
    Range("A1:A" & UBound(ResData) + 1) = Application.WorksheetFunction.Transpose(ResData)
End Sub