NEED MACRO FOR COLOUR BY CONDITIONAL FORMATTING

[K]

Hi, I have data in coloumn A to coloumn E. (please see below)
A B C
D E
000 B10 G628 000B10G628 54
000 B10 G628 000B10G628 53
000 B10 G628 000B10G628 53
000 B10 G628 000B10G628 53
000 B10 000B10 12
000 B10 000B10 13
000 B10 000B10 12
000 B10 000B10 12
in coloumn D i have Formula which is "=A1&B1&C1" as you can see above
and then I put
CONDITIONAL FORMATTING in coloumn D as well in which I put the Formula
which is
"=IF(AND(D2=D3,E2<>E3),TRUE)" its mean that if two values in coloumn D
cells are equal but two values in coloumn E are not equal which are
against each other in same cells then its true and the Cell should
get Red colour. so when ever two values in coloumn D are equal but in
next coloumn E the two values are not equal cell get Red colour by
CONDITIONAL FORMATTING.I want MACRO which can copy only those rows in
which coloumn D cells have Red colour to next sheet. Please Note that
cells getting Red colours by CONDITIONAL FORMATTING and whole coloumn
D have CONDITIONAL FORMATTING. Some friend send me macro but it copy
all data to next sheet instead of just coping only those rows in which
coloumn D cells have Red colour by CONDITIONAL FORMATTING. Please if
anybody can help. Thanks

 

[Joel]

Sub movedata()

OldShRowCount = 1
NewShRowCount = 1
With Sheets("OldSheet")
Do While .Range("D" & OldShRowCount) <> ""
If (.Range("D" & OldShRowCount) = _
.Range("D" & (OldShRowCount + 1))) And _
(.Range("E" & OldShRowCount) <> _
.Range("E" & (OldShRowCount + 1))) Then

.Rows(OldShRowCount).Copy _
Destination:= _
Sheets("NewSheet").Rows(NewShRowCount)
NewShRowCount = NewShRowCount + 1
End If
OldShRowCount = OldShRowCount + 1
Loop
End With

End Sub

 

[K]

Thanks Joel for replying. how can i amend your macro if i want macro
to copy data into next sheet from row 2 as i will be putting headings
in row 1. And also is there way i can get row copy from cell A to
cell F as with your macro its copying entire row.

 

[Joel]

from
NewShRowCount = 1
to
NewShRowCount = 2

Thanks Joel for replying. how can i amend your macro if i want macro
to copy data into next sheet from row 2 as i will be putting headings
in row 1. And also is there way i can get row copy from cell A to
cell F as with your macro its copying entire row.

 

[K]

from
NewShRowCount = 1
to
NewShRowCount = 2






- Show quoted text -

how can i get row lentgh for cell A to cell F to be copied into next
sheet as your macro coping entire row

 

[Joel]

Do you need to only copy certain columns? Your posting said rows, so I
copied rows. Below is modified code to put the last occupied column number
into newsheet

Sub movedata()

OldShRowCount = 1
NewShRowCount = 1
With Sheets("OldSheet")
Do While .Range("D" & OldShRowCount) <> ""
If (.Range("D" & OldShRowCount) = _
.Range("D" & (OldShRowCount + 1))) And _
(.Range("E" & OldShRowCount) <> _
.Range("E" & (OldShRowCount + 1))) Then

.Rows(OldShRowCount).Copy _
Destination:= _
Sheets("NewSheet").Rows(NewShRowCount)
LastColumn =
..Cells(OldShRowCount,columns.Count).end(xltoleft).Column
Sheets("NewSheet"). Cells(NewShRowCount,LastColumn + 1) = _
LastColumn
NewShRowCount = NewShRowCount + 1
End If
OldShRowCount = OldShRowCount + 1
Loop
End With

End Sub

 

[K]

thanks for modified code Joel just last thing in which line i should
put coloumn no. so it only copy that much into new sheet. i tried
putting coloumn no. but its not working.

 

[K]

thanks for modified code Joel just last thing in which line i should
put coloumn no. so it only copy that much into new sheet. i tried
putting coloumn no. but its not working.









- Show quoted text -

sorry i meant that with your code i can copy entire row but what if i
wan to copy row from cell A to cell F. your modified code is still
copying the entire row and putting numbers in last coloumn cells that
how many coloums it copied. i dont want to copy entire row just want
to copy from cell A to cell F which are 6 cells row. i hope you
understood

 

[Joel]

Sub movedata()

OldShRowCount = 1
NewShRowCount = 1
With Sheets("OldSheet")
Do While .Range("D" & OldShRowCount) <> ""
If (.Range("D" & OldShRowCount) = _
.Range("D" & (OldShRowCount + 1))) And _
(.Range("E" & OldShRowCount) <> _
.Range("E" & (OldShRowCount + 1))) Then

Set CopyRange = .Range("A" & OldShRowCount & _
":F" & OldShRowCount)
CopyRange.Copy Destination:= _
Sheets("NewSheet").Range("A" & NewShRowCount)
NewShRowCount = NewShRowCount + 1
End If
OldShRowCount = OldShRowCount + 1
Loop
End With

End Sub

 

[K]

Sub movedata()

OldShRowCount = 1
NewShRowCount = 1
With Sheets("OldSheet")
Do While .Range("D" & OldShRowCount) <> ""
If (.Range("D" & OldShRowCount) = _
.Range("D" & (OldShRowCount + 1))) And _
(.Range("E" & OldShRowCount) <> _
.Range("E" & (OldShRowCount + 1))) Then

Set CopyRange = .Range("A" & OldShRowCount & _
":F" & OldShRowCount)
CopyRange.Copy Destination:= _
Sheets("NewSheet").Range("A" & NewShRowCount)
NewShRowCount = NewShRowCount + 1
End If
OldShRowCount = OldShRowCount + 1
Loop
End With

End Sub






- Show quoted text -

Thanks . This work perfectly fine you are genius