Sub suchen()
Dim workbookquelle As Workbook
Dim workbookziel As Workbook
Dim zelle As Variant
Dim nummer As Long
Dim rng As Range
Dim lngLetzte As Long
Set workbookziel = ActiveWorkbook
Set workbookquelle = Workbooks.Open(ThisWorkbook.Path & "\quelle.xlsx", False, True)
workbookziel.Activate
workbookquelle.Windows(1).Visible = False
With workbookquelle.Sheets("Tabelle2")
lngLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range("A2:A" & lngLetzte)
For Each zelle In rng
If Len(zelle.Value) > 0 Then
nummer = zelle.Value
Debug.Print nummer
End If
Next
End With
workbookquelle.Close Savechanges:=False
Set workbookquelle = Nothing
End Sub