Option Explicit
Public Sub suchen_und_kopieren()
Dim strSQL As String
strSQL = get_sql_string
Dim regEx As New RegExp
With regEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "PPD\d\d\d\d\d\d"
End With
Dim colMatches As MatchCollection
Dim m As Match
Set colMatches = regEx.Execute(strSQL)
If colMatches.Count = 0 Then
GoTo clean_up
End If
For Each m In colMatches
With Worksheets("Tabelle2")
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1) = m.Value
End With
Next m
clean_up:
If Not colMatches Is Nothing Then Set colMatches = Nothing
If Not regEx Is Nothing Then Set regEx = Nothing
End Sub
Private Function get_sql_string() As String
Dim l As Long, k As Long
Dim s As String
With Worksheets("Tabelle1")
k = .Cells(.Rows.Count, 1).End(xlUp).Row
For l = 1 To k
If Not isError(.Cells(l, 1) Then
s = s & .Cells(l, 1)
End If
Next l
End With
get_sql_string = s
End Function