Option Explicit
Public Sub test()
Const MY_FAVOURITES As String = "Favourite_Channels"
Const CHANNEL_STRING As String = "[#]EXTINF:0,Name-Kanal-"
Dim wksSheet As Worksheet
Dim avntSource() As Variant
Dim astrTarget() As String
Dim avntSearchItems() As Variant
Dim ialngIndex As Long, ialngSearch As Long, ialngCount As Long
avntSearchItems = Array("SUPER", "CDEF")
With ThisWorkbook
With .ActiveSheet
avntSource = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 1).Value2
End With
For ialngIndex = 1 To UBound(avntSource, 1)
For ialngSearch = 0 To UBound(avntSearchItems)
If avntSource(ialngIndex, 1) Like CHANNEL_STRING & "*" & avntSearchItems(ialngSearch) & "*" Then
ialngCount = ialngCount + 2
ReDim Preserve astrTarget(0, ialngCount - 1) As String
astrTarget(0, ialngCount - 2) = avntSource(ialngIndex, 1)
astrTarget(0, ialngCount - 1) = avntSource(ialngIndex + 1, 1)
Exit For
End If
Next
Next
If ialngCount > 0 Then
For Each wksSheet In .Worksheets
With wksSheet
If .Name = MY_FAVOURITES Then
Call .Columns(1).ClearContents
.Cells(1, 1).Resize(UBound(astrTarget, 2) + 1, 1).Value2 = WorksheetFunction.Transpose(astrTarget)
Exit For
End If
End With
Next
If wksSheet Is Nothing Then
With .Worksheets.Add(After:=ActiveSheet)
.Name = MY_FAVOURITES
.Cells(1, 1).Resize(UBound(astrTarget, 2) + 1, 1).Value2 = WorksheetFunction.Transpose(astrTarget)
End With
Else
Set wksSheet = Nothing
End If
Else
Call MsgBox("Es konnten keine Favoriten, die mit den" & _
" Suchbegriffen übereinstimmen, gefunden werden", vbExclamation)
End If
End With
End Sub