|
Hallo ALEX,
ich habe quick and dirty nur einige Veränderungen eingefügt. Es geht sicherlich eleganter!
Private Sub jkjkCommandButton1_Click()
Dim rng As Range
Dim rngSource As Range
Dim rngStart As Range
Dim varInput As Variant
Dim iRow As Integer
varInput = InputBox( _
prompt:="Bitte S-Nummer eingeben:", _
Title:="Suche")
If varInput = False Then Exit Sub
Set rng = ActiveSheet.Columns("A:Z").Find( _
What:=varInput, LookAt:=xlWhole, LookIn:=xlValues)
If rng Is Nothing Then
MsgBox "S-Nummer nicht gefunden!"
Exit Sub
End If
iRow = Worksheets("A").Cells(Rows.Count, 1).End(xlUp).Row
If iRow = 1 Then iRow = 2 Else iRow = iRow + 3
Set rngStart = rng
Set rngSource = rng '.EntireRow
Worksheets("Tabelle4").Cells(iRow, 1) = rng.Value
Worksheets("Tabelle4").Cells(iRow, 2) = Cells(rng.Row, 2)
iRow = 1 + iRow
Do
Set rng = Cells.FindNext(After:=rng)
If rng.Address = rngStart.Address Then Exit Do
Worksheets("Tabelle4").Cells(iRow, 1) = rng.Value
Worksheets("Tabelle4").Cells(iRow, 2) = Cells(rng.Row, 2)
iRow = 1 + iRow
' Set rngSource = Union(rngSource, rng.EntireRow)
Loop
Worksheets("Tabelle4").Columns.AutoFit
Exit Sub
With Worksheets("Tabelle4")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row
If iRow = 1 Then iRow = 2 Else iRow = iRow + 3
rngSource.Copy .Cells(iRow, 1)
.Columns.AutoFit
End With
End Sub
|