Public
Sub
Verschieben()
Dim
strSuche
As
String
, raFund
As
Range
Application.ScreenUpdating =
False
With
Worksheets(
"A"
)
strSuche = .Cells(ActiveCell.Row, 1)
Set
raFund = Worksheets(
"B"
).Columns(1).Find(what:=strSuche, LookIn:=xlValues, lookat:=xlWhole)
If
Not
raFund
Is
Nothing
Then
raFund.Resize(, 5).Copy
With
Worksheets(
"C"
)
.Cells(.Rows.Count, 1).
End
(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End
With
raFund.Resize(, 5).Delete shift:=xlUp
Application.CutCopyMode =
False
Else
MsgBox
"Suchbegriff "
& strSuche &
" wurde in Blatt "
"B"
" nicht gefunden."
End
If
End
With
Set
raFund =
Nothing
End
Sub