VBA Paste row based on cell value - Doens't paste in specified cell

[nVaNL]

Good afternoon all;

I am using a VBA-code to copy rows from one worksheet to a different one, based on the value in one of the columns. The issue I encounter is that the copied rows are placed at the bottum row, despite me adding a specified range to the VBA code. I also want to run the module when pressing a button, so the imported rows should be reconcidered when running de module a second time. This last part was not added to the code so far. The code I used:

Sub MoveRowBasedOnCellValue()   Dim xRg As Range   Dim xCell As Range   Dim I As Long   Dim J As Long   Dim K As Long   I = Worksheets("Sheet1").UsedRange.Rows.Count   J = Worksheets("Sheet2").UsedRange.Rows.Count   If J = 1 Then   If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0   End If   Set xRg = Worksheets("Sheet1").Range("C1:C" & I)   On Error Resume Next   Application.ScreenUpdating = False   For K = 1 To xRg.Count      If CStr(xRg(K).Value) = "Actief" Then         xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A1" & J + 1)         J = J + 1      End If   Next   Application.ScreenUpdating = TrueEnd Sub

Is there anything I can change, so that every time I run this code the content of the worksheet where the rows are copied to is whiped, date is added and it all starts from A1?

Yours sincerely,

 

[MARK858]

Do you mean something like the code below?

Sub MoveRowBasedOnCellValue()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long

    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count

    If J = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If

    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)

    'On Error Resume Next
    Application.ScreenUpdating = False

    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Actief" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next

    Application.ScreenUpdating = True
End Sub

Although if you are just trying to paste to the next blank row in column A it is probably easier to use something like

Sub MoveRowBasedOnCellValue()
    Dim xRg As Range
    Dim I As Long
    Dim K As Long

    I = Worksheets("Sheet1").UsedRange.Rows.Count
 

    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)

    'On Error Resume Next
    Application.ScreenUpdating = False

    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Actief" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1)
       End If
    Next

    Application.ScreenUpdating = True
End Sub

Please note that I have commented out the On Error Resume Next