Hallo Mr.Smooth
vielleicht hilft dir das Makro.

Gruß
fedjo

Option Explicit
Sub Suchen()
Dim strSuch As String, lngAnz As Long
strSuch = "2.01"
lngAnz = WorksheetFunction.CountIf(Columns(2), strSuch)
Columns(2).Find(what:=strSuch, LookIn:=xlValues, MatchCase:=False).EntireRow.Insert
End Sub

Hallo Fedjo,

erstmal vielen Dank für Deine schnelle Antwort.

Wenn ich Deine Lösung Ausführe wird nur in der ersten Zeile eine Leerzeile eingefügt. Was muss ich einfügen, um das gesamte Arbeitsblatt (1421 Zeilen) zubearbeiten?

Viele Grüße

Mr. Smooth

hi all

wie gewuenscht

gruss nighty

Sub einfuegen()
    Dim zaehler As Long
    ReDim BereichA(Cells(Rows.Count, 1).End(xlUp).Row, 1) As Variant
    BereichA() = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    For zaehler = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If BereichA(zaehler, 1) = "2.01" Then
            Rows(zaehler & ":" & zaehler).Insert Shift:=xlDown
        End If
    Next zaehler
End Sub

hi all :-)

ups

hier fuer spalte b ^^

gruss nighty

Sub einfuegen()
    Dim zaehler As Long
    ReDim BereichA(Cells(Rows.Count, 2).End(xlUp).Row, 1) As Variant
    BereichA() = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
    For zaehler = 1 To Cells(Rows.Count, 2).End(xlUp).Row
        If BereichA(zaehler, 1) = "2.01" Then
            Rows(zaehler & ":" & zaehler).Insert Shift:=xlDown
        End If
    Next zaehler
End Sub

Hi, dir auch vielen Dank für die schnelle Antwort.

Das Ergebnis der Ausführung ist nicht eindeutig. Mal fügt es unter der Zeile 2.01 eine Leerzeile ein, mal oberhalb der Zeile 2.01 und an anderer Stelle sehr willkürlich.


Die Tabelle sieht wie folgt aus:
Spalte A = 1
Spalte B = 0001
Spalte C = Kaliumdichromat 0,5% vas
Spalte D = 1
Spalte E = 2.01

1 0001 Kaliumdichromat 0,5% vas 1 2.01
................................................................................2 2.02
benötigte Leerzeile
2 0001/1 Kaliumdichromat 0,25% vas 1 2.01
................................................................................2 2.02
benötigte Leerzeile
3 0003 Thiuram Mix [A] 1% vas 1 2.01
.................................................................................2 2.02
.................................................................................3 2.03
.................................................................................4 2.04
.................................................................................5 2.05
benötigte Leerzeile
4 0003/1 Thiuram Mix [B] 1,25% vas 1 2.01
.................................................................................2 2.02
.................................................................................3 2.03
.................................................................................4 2.04
.................................................................................5 2.05
.................................................................................6 2.06
benötigte Leerzeile
5 0004 Neomycinsulfat 20% vas 1 2.01
..................................................................................2 2.02

Jeweils oberhalb der Zeile "2.01" benötige ich eine Leerzeile!

Vielen Dank Ihr seid mir eine große Hilfe!

Mr.Smooth

hi all :-)

ups

gruss nighty

Sub einfuegen()
    Dim zaehler As Long
    ReDim BereichA(Cells(Rows.Count, 2).End(xlUp).Row, 1) As Variant
    BereichA() = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
    For zaehler = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
        If BereichA(zaehler, 1) = "2.01" Then
            Rows(zaehler & ":" & zaehler).Insert Shift:=xlDown
            zaehler = zaehler - 1
        End If
    Next zaehler
End Sub

Tausend Dank nighty, du hast mir ne Menge Arbeit erspart. Die Lösung funktioniert hervorragend.

Viele Grüße

Mr. Smooth

hi all :-)

fedjo seine loesung ist aber auch gut ,nur bisl langsamer :-)

daher ist dieses beispiel fuer fedjo,eine dynamische schleife

gruss nighty

Option Explicit
Sub Suchen()
    Dim suche As Range
    Dim zaehler As Long
    zaehler = 1
    Do
        Set suche = Workbooks(1).Worksheets(1).Range("A" & zaehler & ":A" & Workbooks(1).Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Find("2.01")
        If Not suche Is Nothing Then
            Rem etwas gefunden
            zaehler = suche.Row + 1
        Else
            Rem nicht gefunden
            Exit Do
        End If
    Loop
End Sub

hi all :-)

treffer waere dann

cells(suche.row,suche.column)

gruss nighty