Option Explicit
Public Sub aaa()
Dim loLetzte As Long, loLetzteZiel As Long, i As Long
Dim raBereich As Range, raZelle As Range
With Worksheets("Tabelle2")
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Row
loLetzteZiel = Worksheets("Tabelle3").Cells(Worksheets("Tabelle3").Rows.Count, 1).End(xlUp).Offset(1, 0).Row
If Worksheets("Tabelle3").Cells(1, 1).Value = "" Then loLetzteZiel = 1
For i = 2 To 4
Set raBereich = .Range(.Cells(1, i), .Cells(loLetzte, i))
For Each raZelle In raBereich
If raZelle.Value <> "" Then
If raZelle.Value <> "!" Then
Worksheets("Tabelle3").Cells(loLetzteZiel, 1) = raZelle
loLetzteZiel = loLetzteZiel + 1
End If
End If
Next raZelle
Next i
End With
End Sub