Zeile Ausschneiden/Einfügen, wenn Wert X

Public Sub Move_Done_Transactions()

    Dim objCell As Range

    Dim lngRowsArray() As Long, lngRowCounter As Long, lngCopyRow As Long

    Dim strAddress As String

    With Worksheets("Tabelle1")

        Set objCell = .Columns(13).Find(what:="x", _

            After:=.Columns(13).Cells(.Rows.Count), LookIn:=xlValues, LookAt:=xlWhole)

        If Not objCell Is Nothing Then

            strAddress = objCell.Address

            Do

                lngRowCounter = lngRowCounter + 1

                ReDim Preserve lngRowsArray(1 To lngRowCounter)

                lngRowsArray(lngRowCounter) = objCell.Row

                Set objCell = .Columns(13).FindNext(objCell)

            Loop While Not objCell Is Nothing And objCell.Address > strAddress

            With Worksheets("Tabelle2")

                lngCopyRow = .Cells(.Rows.Count, 6).End(xlUp).Row

            End With

            For lngRowCounter = UBound(lngRowsArray) To 1 Step -1

                lngCopyRow = lngCopyRow + 1

                .Rows(lngRowsArray(lngRowCounter)).Cut

                Worksheets("Tabelle2").Rows(lngCopyRow).Insert Shift:=xlDown

                .Rows(lngRowsArray(lngRowCounter)).Delete

            Next

        End If





    End With

        

    

    

End Sub