Option Explicit
Sub BeispielAufruf()
Dim wksSuch As Excel.Worksheet
Dim rngZiel As Excel.Range
Dim strSuch As String
Set wksSuch = Tabelle1
Set rngZiel = Tabelle2.Range("A1")
strSuch = InputBox(Title:="Suche ...", _
Prompt:="Suchtext angeben:")
If Trim$(strSuch) = "" Then
Exit Sub
ElseIf MySearchCopyAndPaste(strSuch, wksSuch, rngZiel) Then
MsgBox "Vorgang für den Ausdruck '" & strSuch & "' erfolgreich abgeschlossen.", vbInformation
Else
MsgBox "Der Ausdruck '" & strSuch & "' wurde nicht gefunden.", vbExclamation
End If
End Sub
Public Function MySearchCopyAndPaste( _
Search As String, _
SearchWks As Excel.Worksheet, _
PasteTo As Excel.Range, _
Optional CaseSensitive As Boolean _
) As Boolean
Dim rngResult As Excel.Range
Set rngResult = SearchWks.Rows(4).Find( _
What:=Search, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=CaseSensitive)
If Not rngResult Is Nothing Then
Set rngResult = rngResult.Offset(1).Resize(RowSize:=10)
rngResult.Copy PasteTo
MySearchCopyAndPaste = True
End If
End Function