|
Hallo,
Eingabe des gesuchten Artikels in Zelle D1:
Sub Schaltfläche1_Klicken()
Dim raArtikel As Range, raNull As Range, raBereich As Range
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
Set raArtikel = .Columns("B").Find(.Range("D1"), LookIn:=xlValues, lookat:=xlWhole)
If Not raArtikel Is Nothing Then
Set raBereich = .Range(.Cells(raArtikel.Row, "A"), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, "A"))
Set raNull = raBereich.Find(what:=0, LookIn:=xlValues, lookat:=xlWhole)
If Not raNull Is Nothing And raNull.Row <> raArtikel.Row Then
.Range(.Cells(raArtikel.Row, "B"), .Cells(raNull.Row, "B").Offset(-1)).Copy
Worksheets("Tabelle2").Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Else
MsgBox "Fehler: Das Ende für Artikel " & .Range("D1") & " wurde nicht gefunden."
End If
Else
MsgBox "Fehler: Artikel " & .Range("D1") & " nicht gefunden."
End If
End With
Set raArtikel = Nothing: Set raBereich = Nothing: Set raNull = Nothing
End Sub
Gruß Werner
|