Textdatei einlesen und nach genauem Begriff suchen

Private Sub CommandButton1_Click()
'Testwerte. Müssen noch angepasst werden
Const C_SRC_SEARCH_RANGE = "B:B"                        'Suchbereich
'Const C_TRG_WS_NAME = "Daten"
Const C_COLNR_I = 9                                     'i ist Spalte 9
Dim srcWb As Workbook
Dim srcWs As Worksheet
Dim trgWb As Workbook
Dim trgWs As Worksheet
Dim r As Range
Dim trgLastRowNr As Long
Dim actAlerts As Boolean
Dim C_TRG_WS_NAME As String
Dim srcPath As String
Dim srcSearchValue As String
'  Dim trgColNr As Long
'Dateipfad ermitteln
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "CSV Files", "*.csv"
.Filters.Add "All Files", "*.*"
.FilterIndex = 1
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Keine Datei ausgewählt, Vorgang wird abgebrochen", vbExclamation + vbOKOnly
Exit Sub
End If
srcPath = .SelectedItems(1)
End With
'Suchwert abfragen
srcSearchValue = InputBox("Suchwert in Spalte B")
C_TRG_WS_NAME = InputBox("Name des Arbeitsblattes")
'Ziel Workbook
Set trgWb = ActiveWorkbook
'Quell Workbook und Sheet
Set srcWb = Workbooks.Add(srcPath)
Set srcWs = srcWb.Worksheets(1)
'Das CSV ist als Text in der ersten Spalte - Das ganze mit TextToColumns auf die Spalten  _
aufteilen
actAlerts = Application.DisplayAlerts   'aktuelle DisplayAlerts merken
Application.DisplayAlerts = False       'DisplayAlerts ausschalten
srcWs.Range("A:A").TextToColumns Destination:=srcWs.Range("A1"), DataType:=xlDelimited,  _
Semicolon:=True
Application.DisplayAlerts = actAlerts   'DisplayAlerts zurücksetzen
'Die Spalte B durchsuchen
For Each r In srcWs.Range(C_SRC_SEARCH_RANGE)
If r.Value = srcSearchValue Then
'Falls das Ziel-Sheet noch nicht definiert wurde, das machen (wird nur beim ersten  _
Treffer ausgeführt)
If trgWs Is Nothing Then
Set trgWs = createOrGetWorksheet(trgWb, C_TRG_WS_NAME)
trgLastRowNr = trgWs.Cells.SpecialCells(xlCellTypeLastCell).Row
' trgColNr = trgWs.Cells.SpecialCells(xlCellTypeLastCell).Column + 1
End If
'Nächste Freie Zeilen ermitteln
trgLastRowNr = trgLastRowNr + 1
'Wert aus Spalte I übernehmen
trgWs.Cells(trgLastRowNr, 1) = srcWs.Cells(r.Row, C_COLNR_I).Value
'  trgWs.Cells(trgLastRowNr, 1) = srcWs.Cells(r.Row, trgColNr).Value
End If
Next r
srcWb.Close False
End Sub

Private Function createOrGetWorksheet(ByRef ioWb As Workbook, ByVal iWsName As String) As  _
Worksheet
Dim ws As Worksheet
For Each ws In ioWb.Worksheets
If (UCase(ws.Name) = UCase(iWsName)) Then
Set createOrGetWorksheet = ws
Exit Function
End If
Next ws
Set createOrGetWorksheet = ioWb.Worksheets.Add
createOrGetWorksheet.Name = iWsName
End Function