select,copy,paste by color
 

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

select,copy,paste by color
 

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

select,copy,paste by color
 

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" wrote:


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

select,copy,paste by color
 

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

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


Barry Lennox;192926 Wrote:
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" wrote:


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' ('The Code Cage' (http://www.thecodecage.com))

------------------------------------------------------------------------
The Code Cage Team's Profile: 'The Code Cage Forums - View Profile:
The Code Cage Team'
(http://www.thecodecage.com/forumz/me...cage-team.html)
View this thread: 'select,copy,paste by color - The Code Cage Forums'
(http://www.thecodecage.com/forumz/sh...ad.php?t=52699)




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

select,copy,paste by color
 

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" wrote:


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

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

select,copy,paste by color
 

What data? from where? in what order?
Why noy join our forum where you can attach a workbook that we can help
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 that
people who have been following this thread or helping can continue to do
so!

Barry Lennox;193271 Wrote:
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" wrote:


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

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






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