|
...und zurück. Habs gefunden.
Ich habe die Prüfzelle auf das Tabellenblatt 2 verlagert und die Range der kopierten Spalten bis "V" erweitert. Der Vollständigkeit halber hier der Code:
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(Sheets("Tabelle2").Range("B2"), 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, "V").Offset(-1)).Copy
Worksheets("Tabelle2").Range("A5").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 " & Sheets("Tabelle2").Range("B2") & " nicht gefunden."
End If
End With
Set raArtikel = Nothing: Set raBereich = Nothing: Set raNull = Nothing
End Sub
Vielen Dank an Werner für die schnelle und treffsichere Hilfe!! TOP!!
Gruß Dominik
|