Hej hej

Nedan kod gör jobbet. Ordrarna läses kopieras och raderas nedifrån och upp. Går att läsa uppifrån och ner med, men detta tar längre tid att programmera. Du behöver ändra enligt mina kommentarer för att koden ska fungera.

Mvh

Christian

Sub TransferOrders()

    'Ändra bladnamn så det stämmer med hur du har det på de två raderna nedan. sws, Sourceworksheet är källan, dws (destinationworksheet)

    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("Blad1")

    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("Blad2")

    Dim Printrow As Long

    Printrow = dws.usedrange.Rows(dws.usedrange.Rows.Count).Row + 1

    Dim mcell As Range

    Dim i As Long

    'Ändra så att kolumnnumret usedrange.Columns(1) är där det står nej, (A är 1)

    For i = sws.usedrange.Columns(1).Cells.Count To 1 Step -1

        'Ändra så att mcell sätts till Nej-kolumnen

        Set mcell = sws.usedrange.Cells(i, 1)

        'Ändra så att förskjutningen från Nej-kolumnen hamnar i saldokolumnen (offset(0, 3)

        If UCase(mcell) = "NEJ" Or mcell.Offset(0, 3) > 0 Then

            mcell.EntireRow.Copy dws.Rows(Printrow)

            mcell.EntireRow.Delete

            Printrow = Printrow + 1

        End If

    Next i

End Sub