This should do what you need!

Code:
--------------------
Sub Move_Colours()
Dim Rng As Range, MyCell As Range
Dim Rng1 As Range, Rng2 As Range
Dim MySheet As String, NewSheet As Worksheet
Dim i As Long
Set Rng = Range("B1:B100")
'if you have data in column B you can use the line below
'Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
i = 0
MySheet = ActiveSheet.Name
Worksheets.Add
ActiveSheet.Name = "Transferred Data"
Set NewSheet = ActiveSheet

Sheets(MySheet).Activate
For Each MyCell In Rng
If MyCell.Interior.ColorIndex < xlNone Then
i = i + 1
MyCell.Copy
Set Rng1 = NewSheet.Range("A" & i)
With Rng1
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
MyCell.Offset(0, -1).Copy Destination:=Rng1.Offset(0, 1)
MyCell.Offset(0, 1).Copy Destination:=Rng1.Offset(0, 2)
End If
Next MyCell
End Sub
--------------------


Barry Lennox;191277 Wrote:
My problem was partially answered in a discussion on 3/12/08.
I wish to select all coloured cells in column "B" and paste them in
column
"A" in "New Sheet". What I also need is the contents of adjacent cell
to the
left (column"A") in old sheet to go to Column "B" in new sheet and the
contents of adjacent cell to the right (column"C") in old sheet to go
to
Column "C" in new sheet.
So that contents of say a,b,c36 in old sheet become b,a,c,1 in new
sheet and
say a,b,c49 in old sheet become b,a,c,2 in new sheet

Barry


--
The Code Cage Team

Regards,
The Code Cage Team
'The Code Cage' (http://www.thecodecage.com)
------------------------------------------------------------------------
The Code Cage Team's Profile: http://www.thecodecage.com/forumz/member.php?userid=2
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=52699