Zeilen anfügen und füllen per UserForm-Eingabe

Public Sub Suchen()
Dim WB As Workbook
Dim strInbox As String
Dim zelle As Range
Dim intWks As Integer
Dim Wahl As String
Dim FirstAddress
Dim bln As Boolean
strInbox = InputBox("ARTIKELSUCHE")
If strInbox = "" Then
Exit Sub
End If
For Each WB In Workbooks
WB.Activate
For intWks = 1 To ActiveWorkbook.Sheets.Count
With Worksheets(intWks).UsedRange
Set zelle = .Find(strInbox, LookIn:=xlValues)
If Not zelle Is Nothing Then
FirstAddress = zelle.Address
bln = True
Do
Worksheets(intWks).Select
zelle.Select
Wahl = _
MsgBox("[ " & strInbox & " ] gefunden in: " & vbCr _
& vbCr & "Mappe: " & WB.Name _
& vbCr & "Tabelle: " & Worksheets(intWks).Name _
& vbCr & " Zelle: " & zelle.Address(0, 0) _
& vbCr & vbCr & "Weitersuchen?", vbYesNo)
If Wahl = vbNo Then
Set zelle = Nothing
Exit Sub
End If
Set zelle = .FindNext(zelle)
Loop While Not zelle Is Nothing And zelle.Address  FirstAddress
End If
End With
Next intWks
Next WB
If bln = False Then
MsgBox "Der Suchbegriff [" & strInbox & "] wurde nicht gefunden."
End If
Set zelle = Nothing
Workbooks.Activate
End Sub

Vielen Dank schon mal für euer Bemühen!
Grüße
Flo07