Hulp gevraagd bij het wijzigen van een macro

[N12047]

Hallo,

Onderstaande macro gebruik ik om een aantal cellen te kopiëren naar een ander tabblad.
Het kopiëren gebeurt pas als een bepaalde cel een voorwaarde 1 of 2 heeft.
Deze macro waar ik weken over gedaan heb om hem goed te krijgen, werkt naar alle tevredenheid.

Graag zou ik de macro willen wijzigen in het volgende, maar om nu weer weken lang trail en error te doen…..

Onderstaan moet dusdanig gewijzigd worden dat als;

• Als ik NA het kopiëren een regel wijzig op tabblad "Audit Form", deze bij een volgende kopieer actie op tabblad “Corrective Action” deze regel uit de lijst verwijderd wordt, (dat houdt in dat als hij niet meer aan de voorwaarde voldoet, oftewel >2).
Dit werkt! Maar de commentaar velden moeten dan ook verplaatst worden (Kolom D,E,F en G).
• OF; dat als hij wel aan de voorwaarde voldoet (<3) deze er dan weer bijgevoegd (onderaan) wordt op tabblad “Corrective Action” bij een volgende kopieer actie. (Dit werkt nog niet)
• Het zou leuk zijn als er een regelnummer in gezet kan worden in het tabblad “Corrective Action” Range A21:A

Wie wil mij hierbij helpen?

Bijgevoegd een zeer uitgekleed voorbeeld bestand.

Sub CopyCells()

    With Worksheets("Corrective Action").Range("B21:G100").ClearContents
    End With

    Dim c
    With Sheets("Audit Form")
        For Each c In .Range("A21:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
            If Cells(c.Row, "F") = "1" Then
                Range(Cells(c.Row, "A"), Cells(c.Row, "B")).Copy
                Sheets("Corrective Action").Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial xlValues

            Else
                If Cells(c.Row, "F") = "2" Then
                    Range(Cells(c.Row, "A"), Cells(c.Row, "B")).Copy
                    Sheets("Corrective Action").Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial xlValues
                End If
            End If
        Next
    End With

End Sub

 

[HSV]

Ik heb je samengevoegde cellen verwijderd.
Test het maar eens.