Copy and paste from one sheet to another, but not so simple

[Flick]

Hi all,

I have a macro that currently finds rows where "Complete!" is in column H and then clears the contents of the entire row. What I need to do now is for the macro to find the rows with "Complete!", but copy it other to another sheet (named "Complete") where the next empty cell is available, and then clear the contents in the original sheet afterwards. Here is my macro so far:

Last = Cells(Rows.Count, "C").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "H").Value) = "Complete!" Then
Cells(i, "C").EntireRow.ClearContents
End If
Next i

Is there a simple way of doing this? I've tried a few methods but to no avail.

 

[jindon]

AutoFilter....

Sub test()
    With ActiveSheet
        With Intersect(.Columns("h"), .UsedRange)
            .AutoFilter 1, "Complete"
            .Offset(1).EntireRow.Copy Sheets("complete").Range("a" & Rows.Count).End(xlUp)(2)
            .Offset(1).ClearContents
            .AutoFilter
        End With
    End With
End Sub

If this doesn't work, need to see your workbook.

 

[Flick]

Thanks for replying. Sadly it didn't work so I've uploaded the To-Do sheet. Beware though, the code is a mish-mash of poor amateurism... but it does the job!

 

[Flick]

Ok, now I've uploaded it...

 

[jindon]

HOw about

Sub test()
    With ActiveSheet
        With Intersect(.Columns("h"), .UsedRange)
            .AutoFilter 1, "Complete"
            On Error Resume Next
            .Offset(1).SpecialCells(12).EntireRow.Copy Sheets("complete").Range("a" & Rows.Count).End(xlUp)(2)
            .Offset(1).SpecialCells(12).EntireRow.ClearContents
            On Error GoTo 0
            .AutoFilter
        End With
    End With
End Sub

 

[jindon]

Probably

Sub test()
    With ActiveSheet
        With Intersect(.Columns("c:h"), .UsedRange)
            .AutoFilter 6, "Complete"
            On Error Resume Next
            .Offset(1).SpecialCells(12).Copy Sheets("complete").Range("a" & Rows.Count).End(xlUp)(2)
            .Offset(1).SpecialCells(12).ClearContents
            On Error GoTo 0
            .AutoFilter
        End With
    End With
End Sub

 

[Flick]

For me, it's not moving the data across, and is also making all the checkboxes on the left disappear. If it's a lost cause, don't worry, I'll try to make something new!

 

[jindon]

Try this one then

Sub test()
    Dim x, a, i As Long
    With Sheets("todo")
        With Intersect(.Columns("c:h"), .UsedRange)
            x = Filter(.Parent.Evaluate("transpose(if(" & .Columns(6).Address & _
            "=""complete"",row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
            If UBound(x) > -1 Then
                a = Application.Index(.Value, Application.Transpose(x), [{1,2,3,4,5}])
                Sheets("complete").Range("a" & Rows.Count).End(xlUp)(2).Resize(UBound(a, 1), 5).Value = a
            End If
        End With
        For i = LBound(x) To UBound(x)
            .Rows(x(i)).ClearContents
        Next
    End With
End Sub