gesucht wird eine Routine die in der Spalte K Zeile 1 beginnen die Blöcke zwischen Beginn wie -->
Sub Sub GetHTMLData2() und End Sub in die Spalte I , immer untereinander verschieben soll.
Es sollen nur genommen werden Sub Texte die Enden immer mit 1 oder 2 stellige Zahlen vor der ersten Klammer.
wie Beispiel
------ Beispiel ---------------
Sub GetHTMLData2()
texte........
texte........
End Sub
Sub TEXT_To_HTML()
texte........
End Sub
Sub GetHTMLData12()
texte........
texte........
End Sub
-----------------------------------------------------------
Ich finde die entscheidende Formel nicht für
If subName Like "[0-9](*)" Or subName Like "[0-9][0-9](*)" Then ' Prüfen auf einstellige Zahl + "(" oder zweistellige Zahl + "("
------------derzeitiges Programm --------------------------
Sub VerschiebeBloecke()
Dim lastRow As Long
Dim srcRow As Long
Dim destRow As Long
Dim blockStart As Long
Dim subName As String, FEN1, ASN
Application.DisplayAlerts = False: Application.ScreenUpdating = False
FEN1 = ActiveWorkbook.Name: Windows([FEN1]).Activate: [B11] = FEN1: ASN = ActiveSheet.Name: Sheets(ActiveSheet.Name).Select:
Range("K1").Select: lastRow = Cells(Rows.Count, "K").End(xlUp).Row
Range("K1").Select: destRow = 1
For srcRow = 1 To lastRow
subName = Trim(Left(Cells(srcRow, "K").value, Len(Cells(srcRow, "K").value) - 1))
Range("G13") = subName ' Zur Kontrolle Chr(48-57)
Range("G15") = srcRow ' Zur Kontrolle
If subName Like "[0-9](*)" Or subName Like "[0-9][0-9](*)" Then ' Prüfen auf einstellige Zahl + "(" oder zweistellige Zahl + "("
' Beginn eines Blocks gefunden
blockStart = srcRow
ElseIf Cells(srcRow, "K").value = "End Sub" And blockStart > 0 Then
' Ende eines Blocks gefunden
For destRow = blockStart To srcRow
Cells(destRow, "I").value = Cells(destRow, "K").value
Next destRow
blockStart = 0
End If
Next srcRow
End Sub