Wert finden u Zeile einfügen nach bestimmten Wert

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Michael,
vielen Dank für deine schnelle Antwort.
Also in Spalte F stehen verschiedene Wörter unter anderem "Hallo" und "Montag". Wenn ein "Hallo" kommt folgt immer irgendwann ein "Montag" vor dem nächsten "Hallo". Hier soll zu jedem Hallo unter dem jeweiligen "Montag" eine Zeile "Storno Hallo" eingefügt werden.
Bsp.:
Spalte F
Bezeichnung
Haus
Garten
Hallo
Tanzen
Auto
Montag
Haus
Garten
Hallo
Auto
Montag
...
Bisher habe ich folgenden Code, dieser fügt aber nur unter dem "Hallo" direkt ein "Storno Hallo" ein.
For e = 1 To 300
If Cells(e, 6).Value = "Hallo" Then
Cells((e + 1), 6).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.FormulaR1C1 = "Storno Hallo"
End If
MfG
Stefan

Sub Hallo() Dim rngH As Range, rngM As Range Dim strFirst As String With ActiveSheet Set rngH = .Range("F:F").Find(What:="Hallo", LookIn:=xlValues, LookAt:=xlWhole, _ MatchCase:=False, SearchFormat:=False, After:=.Cells(.Rows.Count, 6), _ SearchDirection:=xlNext, SearchOrder:=xlByRows) If Not rngH Is Nothing Then strFirst = rngH.Address Do Set rngM = Nothing Set rngM = .Range("F:F").Find(What:="Montag", LookIn:=xlValues, LookAt:=xlWhole, _ MatchCase:=False, SearchFormat:=False, After:=rngH) If Not rngM Is Nothing And rngM.Row > rngH.Row Then rngM.Offset(1, 0).Insert xlDown, xlFormatFromLeftOrAbove rngM.Offset(1, 0) = "Storno Hallo" End If Set rngH = .Range("F:F").Find(What:="Hallo", LookIn:=xlValues, LookAt:=xlWhole, _ MatchCase:=False, SearchFormat:=False, After:=rngH) Loop While Not rngH Is Nothing And strFirst <> rngH.Address End If End With Set rngH = Nothing Set rngM = Nothing End Sub

Hallo Stefan,

Sub Hallo()
Dim rngH As Range, rngM As Range
Dim strFirst As String

With ActiveSheet
  Set rngH = .Range("F:F").Find(What:="Hallo", LookIn:=xlValues, LookAt:=xlWhole, _
    MatchCase:=False, SearchFormat:=False, After:=.Cells(.Rows.Count, 6), _
    SearchDirection:=xlNext, SearchOrder:=xlByRows)
  If Not rngH Is Nothing Then
    strFirst = rngH.Address
    Do
      Set rngM = Nothing
      Set rngM = .Range("F:F").Find(What:="Montag", LookIn:=xlValues, LookAt:=xlWhole, _
        MatchCase:=False, SearchFormat:=False, After:=rngH)
      If Not rngM Is Nothing And rngM.Row > rngH.Row Then
        rngM.Offset(1, 0).EntireRow.Insert xlDown, xlFormatFromLeftOrAbove
        rngM.EntireRow.Copy .Cells(rngM.Row + 1, 1)
        rngM.Offset(1, 0) = "Storno Hallo"
      End If
      Set rngH = .Range("F:F").Find(What:="Hallo", LookIn:=xlValues, LookAt:=xlWhole, _
        MatchCase:=False, SearchFormat:=False, After:=rngH)
    Loop While Not rngH Is Nothing And strFirst <> rngH.Address
  End If
End With


Set rngH = Nothing
Set rngM = Nothing
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Wert finden u Zeile einfügen nach bestimmten Wert

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

184 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wert finden u Zeile einfügen nach bestimmten Wert

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

184 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread