select,copy,paste by color

[Barry Lennox]

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]

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 Su
-------------------

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 i
column
"A" in "New Sheet". What I also need is the contents of adjacent cel
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 g
to
Column "C" in new sheet.
So that contents of say a,b,c36 in old sheet become b,a,c,1 in ne
sheet and
say a,b,c49 in old sheet become b,a,c,2 in new sheet

Barr

--
The Code Cage Tea

Regards,
The Code Cage Team
'The Code Cage' (http://www.thecodecage.com

 

[Barry Lennox]

Thanks team.

It works. I realised after running it that it needed some changes (copying
value not format), and that I need to select a colour as there are other
coloured cells that aren't needed that I forgot about. Can you throw in the
code for say three different colours. at present I just have "ColorIndex = 6"
(one I use is yellow "6")

Barry

 

[The Code Cage Team]

Try this:

Code
-------------------
Sub Move_Colours()
Dim Rng As Range, MyCell As Range
Dim Rng1 As Range
Dim MySheet As String, NewSheet As Worksheet
Dim i As Long
Dim IB As Variant
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
'if you want to choose colours by number uncomment below
'ib=inputbox("Please enter the colour number you wish to manipulate","Colour pick",6,,,,1)
For Each MyCell In Rng
'if using the colour pick above uncomment the line below
'If MyCell.Interior.ColorIndex = IB Then
'and comment out the next 2 lines
If MyCell.Interior.ColorIndex = 6 Or MyCell.Interior.ColorIndex = 5 _
Or MyCell.Interior.ColorIndex = 4 Or MyCell.Interior.ColorIndex = 3 Then
i = i + 1
MyCell.Copy
Set Rng1 = NewSheet.Range("A" & i)
With Rng1
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlValues
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

-------------------

Thanks team.

It works. I realised after running it that it needed some change
(copying
value not format), and that I need to select a colour as there ar
other
coloured cells that aren't needed that I forgot about. Can you throw i
the
code for say three different colours. at present I just hav
"ColorIndex = 6"
(one I use is yellow "6")

Barry


The Code Cage Team
(http://www.thecodecage.com/forumz/members/the-code-cage-team.html)

--
The Code Cage Team

Regards,
The Code Cage Team
'The Code Cage' (http://www.thecodecage.com)

 

[Barry Lennox]

Thanks team
One more (I hope) variation. I am just coming out of using macros in Escel
and have no training in VBA, just learning as I go. Ho do I copy my
information to an existing sheet say "invoice". I have tried playing with the
code below, deleting and changing things but I give in, help please.

Barry

 

[The Code Cage Team]

What data? from where? in what order?
Why noy join our forum where you can attach a workbook that we can hel
you with directly? if you do join the forum which is completely free
make sure that you post in this thread http://tinyurl.com/dzy37e so tha
people who have been following this thread or helping can continue to d
so!

Thanks team
One more (I hope) variation. I am just coming out of using macros i
Escel
and have no training in VBA, just learning as I go. Ho do I copy my
information to an existing sheet say "invoice". I have tried playin
with the
code below, deleting and changing things but I give in, help please.

Barry

Try this:

Code:
--------------------
Sub Move_Colours()
Dim Rng As Range, MyCell As Range
Dim Rng1 As Range
Dim MySheet As String, NewSheet As Worksheet
Dim i As Long
Dim IB As Variant
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
'if you want to choose colours by number uncomment below
'ib=inputbox("Please enter the colour number you wish t

manipulate","Colour pick",6,,,,1)

For Each MyCell In Rng
'if using the colour pick above uncomment the line below
'If MyCell.Interior.ColorIndex = IB Then
'and comment out the next 2 lines
If MyCell.Interior.ColorIndex = 6 Or MyCell.Interior.ColorIndex = _
Or MyCell.Interior.ColorIndex = 4 Or MyCell.Interior.ColorIndex = Then
i = i + 1
MyCell.Copy
Set Rng1 = NewSheet.Range("A" & i)
With Rng1
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlValues
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

--
The Code Cage Tea

Regards,
The Code Cage Team
'The Code Cage' (http://www.thecodecage.com