I need to find color cell, cut the range and paste them into another sheet

[michellin]

Hi there,

I start a Macro but i need help.

My needs :

find all yellow cell (color#6) in column A from sheet1,
then cut all the line (A:M) or entire row when in found in a cell yellow #6,
to the sheet2 from range a2 (range a1 is my title) going down without erasing the last line,
and circle them all.
And add more next day on the next line. like it starting to the last unused range, to never erase full line
And make sure the cell format is coming with it.

I got this, but is stopping after only one cut, how i can fix it to go down till range 1001 max or entire sheet.

Sub Cutcolor()

With Selection.Font
.Color = 6
.TintAndShade = 0
End With

Selection.EntireRow.Copy Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Selection.EntireRow.Delete xlShiftUp

End Sub

That macro work, but stop after the first line, i need to run it multiple time, and sometimes it cut none coloring range.

Im using on sheet1, column from A to M, range a1 is title, so range 2 to 1001

in bonus if thats exist, i would love to get the date at the end of the copied line in column N. fonction now or today.

I hope i'm clear, sorry for my bad english, i know the forum get another language page, but the best are here.

Thanks for your help, i really try a lot by myself, and reseach here and internet. But i'm a noob...

i'm pretty sure it would be super easy for you.

Thanks a lot guys or girl, thanks a lot people

Michellin

 

[ER_Neha]

Hello I couldn't solve your interest for circling the row but rest I think I managed to solve. Please try this. and do share your feedback

Sub moving_todiff_sheet()
    Dim i As Integer
    Dim j As Integer
    j = 2
    For i = 2 To 1001
        If Range("a" & i).Interior.color = vbYellow Then
            Range("a" & i).EntireRow.Copy Worksheets(2).Range("a" & j)
            Range("a" & i).EntireRow.Delete
            i = i - 1
            j = j + 1
        End If
    Next i
End Sub

 

[michellin]

Hi er_neha

Thats work great, it moving every yellow one to the other sheet.

The only thing that bug, it if i run it a second time, the macro overwrite, and restart on line 2.

It why i was starting utilising offset to make sure, he find the last row+1 and write the next row on the last blank row.

Thanks a lot