Text suchen, dann Zeile einfügen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Selma ;-))

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub insertLines()
  Dim rng As Range
  Dim lngCalc As Long
  Dim lnglast As Long, lngI As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = -4135
    .DisplayAlerts = False
  End With
  
  With ActiveSheet
    lnglast = Application.Max(6, .Cells(.Rows.Count, 1).End(xlUp).Row)
    For lngI = lnglast To 6 Step -1
      If .Cells(lngI, 2) Like "[[]SOURCE=*" Then
        .Rows(lngI + 1).EntireRow.Insert
        .Cells(lngI + 1, 2) = "[MODEL=:Default:]"
      End If
    Next
  End With
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'insertLines'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Prozedur - insertLines"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
    .StatusBar = False
  End With
  
End Sub

Gruß Sepp

Sub Einfügen() With ActiveSheet.UsedRange With .Columns(.Columns.Count).Offset(0, 1).Resize(, 2) .Columns(1).Formula = "=Row()" .Columns(2).FormulaR1C1 = "=IF(Left(RC2,8)=""[SOURCE="",Row(),"""")" .Formula = .Value .Columns(2).SpecialCells(xlCellTypeConstants, 1).Copy .Cells(.Rows.Count, 1).Offset(1, 0).PasteSpecial xlPasteValues Selection.Offset(0, 2 - Selection.Column).Value = "[MODEL=:Default:]" .CurrentRegion.EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo .EntireColumn.ClearContents End With End With End Sub

Beliebteste Forumthreads (12 Monate)

Text suchen, dann Zeile einfügen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Text suchen, dann Zeile einfügen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread