Option Explicit
Public Sub test()
Const START_COLUMN As Long = 18
Const END_COLUMN As Long = 51
Const START_ROW As Long = 1
Const END_ROW As Long = 31
Dim ialngIndex As Long, ialngRow As Long, _
ialngColumn As Long
Dim avntArray As Variant
Dim avntTemp() As Variant
avntArray = WorksheetFunction.Transpose(ActiveSheet.Cells(START_ROW, START_COLUMN).Resize(END_ROW, END_COLUMN))
For ialngRow = 1 To UBound(avntArray, 1)
For ialngColumn = 1 To UBound(avntArray, 2)
If avntArray(ialngRow, ialngColumn) <> vbNullString Then
ialngIndex = ialngIndex + 1
ReDim Preserve avntTemp(0, ialngIndex - 1) As Variant
avntTemp(0, ialngIndex - 1) = avntArray(ialngRow, ialngColumn)
End If
Next
Next
With Worksheets("Export_bereich")
.UsedRange.ClearContents
.Cells(1, 1).Resize(1, UBound(avntTemp, 2) + 1) = avntTemp
End With
End Sub