With exApp
            .Workbooks.Open(Pfad & Datei).Activate()
            .Visible = True
            .Sheets("Kunden").select()
            i = 0
            .Range("A2").Select()
            .Application.ScreenUpdating = False
            Do
 
                If .ActiveCell.Offset(i, 0).Text = "Ende" Then
                    Exit Do
                End If
 
                ReDim Preserve HKu(i), KdNr(i), Kund(i), Vorn(i), Stra(i), _
                  PostLZ(i), Stadt(i), Tel(i), Fax(i), sMail(i)
                HKu(i) = .ActiveCell.Offset(i, 0).Text
                KdNr(i) = .ActiveCell.Offset(i, 1).Text
                Kund(i) = .ActiveCell.Offset(i, 2).Text
                Vorn(i) = "V"
                Stra(i) = .ActiveCell.Offset(i, 3).Text
                PostLZ(i) = .ActiveCell.Offset(i, 4).Text
                Stadt(i) = .ActiveCell.Offset(i, 5).Text
                Tel(i) = .ActiveCell.Offset(i, 6).Text
                Fax(i) = .ActiveCell.Offset(i, 7).Text
                sMail(i) = .ActiveCell.Offset(i, 8).Text
 
                i = i + 1
            Loop
            .Application.ScreenUpdating = True
            Label1.Text = i - 1
            .Workbooks("Kunden.xls").Close(False)
            .Quit()
        End With
        exApp = Nothing

Gru? aus dem Norden
manyki