Public Sub Zahlen_kopieren()
Dim loLetzteQ As Long, loLetzteZ As Long
Dim raBereich As Range, raZelle As Range
Dim ws As Worksheet, wsZiel As Worksheet
Set wsZiel = Worksheets("Tabelle1")
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Tabelle1" Then
loLetzteZ = wsZiel.Cells(wsZiel.Rows.Count, 1).End(xlUp).Row + 1
With ws
loLetzteQ = .Cells(.Rows.Count, 5).End(xlUp).Row
Set raBereich = .Range(.Cells(1, 5), .Cells(loLetzteQ, 5))
For Each raZelle In raBereich
If IsNumeric(raZelle) Then
raZelle.EntireRow.Copy wsZiel.Cells(loLetzteZ, 1)
loLetzteZ = loLetzteZ + 1
End If
Next raZelle
End With
End If
Next ws
Application.ScreenUpdating = True
End Sub