Macro to copy selected column data and always paste into same Column

rudogg

rudogg

New Member
Joined
Mar 18, 2022
Messages
28
Office Version
  1. 365
Platform
  1. Windows
Hello:

I am looking to create a macro that will be a ribbon button, that will copy values that have already been selected by the user, in either columns C,D or E and always paste them in column B. See table below for an example.

The user selects cells 1, 2 and 3 of data in col C and runs the macro assigned to the button and that will copy and paste the selection into cells 1, 2 and 3 of Col B.

The user selects cells 4, 5 and 6 of data in col D and runs the macro assigned to the button and that will copy and paste the selection into cells 4, 5 and 6 of Col B.

The user selects cells 7, 8 and 9 of data in col E and runs the macro assigned to the button and that will copy and paste the selection into cells 7, 8 and 9 of Col B.

I hope this all makes sense.

Col A current priceCol B new priceCol C 10% off current priceCol D 15% off current PriceCol E 20% off current price
10998.58
10090908580
1000900900850800
123132423234132654
345546823423454686521321
2346546546654654
476123515965751235
3645321534865431565432153
46756713515868543586135158
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Here you go :)

Let me know if its doing what you expected
VBA Code: 
Sub rudogg_CopyPaste()
    For Each rw In Selection.Cells
        ActiveSheet.Range("B" & rw.Row) = rw
    Next rw
End Sub

One thing it isn't doing, is copying the formatting of the cell (if its in bold or whatnot)... let me know if that is important to you.
cheers
 
Upvote 0
Solution
ouvay said:
Here you go :)

Let me know if its doing what you expected
VBA Code: 
Sub rudogg_CopyPaste()
    For Each rw In Selection.Cells
        ActiveSheet.Range("B" & rw.Row) = rw
    Next rw
End Sub

One thing it isn't doing, is copying the formatting of the cell (if its in bold or whatnot)... let me know if that is important to you.
cheers
Click to expand...
@ouvay This does exactly what I was looking for! Thank you kindly!
 
Upvote 0
rudogg said:
@ouvay This does exactly what I was looking for! Thank you kindly!
Click to expand...
I would however, like to point out that in the OP you mentioned that
rudogg said:
in either columns C,D or E
Click to expand...
But I have made no such restriction in the solution I provided.
If you want that the argument, that the source data be from c,d or e.. I'll be happy to work that in on Monday :)
 
Upvote 0
ouvay said:
I would however, like to point out that in the OP you mentioned that

But I have made no such restriction in the solution I provided.
If you want that the argument, that the source data be from c,d or e.. I'll be happy to work that in on Monday :)
Click to expand...
As a matter of fact, after using this real time for a bit, I could use some logic that says the data has to come from specific columns.

Currently those columns are CZ, DC, DF, and DI.

If it's not too much to ask, it would be awesome, when pasting the data into column B, that the data could be color coded based on static RGB Colors

So, if pasted to B from CZ, Interior.Color = RGB(224, 224, 224)
or if pasted B from DC, Interior.Color = RGB(220, 220, 0), and so on.

Let me know if that makes sense, and thank you ever so kindly, for your help with this post!
 
Upvote 0
Hi

Hope I've understood it correctly... but to be sure, I'm posting two options

have a look

VBA Code: 
Option Base 1
Sub rudogg_CopyPaste() '' this will colour the the source and the pasted result (hopefully this will help to understand where the values are coming from)
    Dim arr As Variant
    arr = Array(Columns("CZ").Column, Columns("DC").Column, Columns("DF").Column, Columns("DI").Column)  '' change columns here as per requirements
    For Each rw In Selection.Cells
        For Each col In arr
            If col = rw.Column Then
                ActiveSheet.Range("B" & rw.Row) = rw
                If col = arr(1) Then
                    For Each othr In arr
                        ActiveSheet.Cells(rw.Row, othr).Interior.Color = RGB(255, 255, 255)
                    Next othr
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(255, 0, 0)
                    ActiveSheet.Cells(rw.Row, col).Interior.Color = RGB(255, 0, 0)
                ElseIf col = arr(2) Then
                    For Each othr In arr
                        ActiveSheet.Cells(rw.Row, othr).Interior.Color = RGB(255, 255, 255)
                    Next othr
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(0, 255, 255)
                    ActiveSheet.Cells(rw.Row, col).Interior.Color = RGB(0, 255, 255)
                ElseIf col = arr(3) Then
                    For Each othr In arr
                        ActiveSheet.Cells(rw.Row, othr).Interior.Color = RGB(255, 255, 255)
                    Next othr
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(0, 255, 0)
                    ActiveSheet.Cells(rw.Row, col).Interior.Color = RGB(0, 255, 0)
                ElseIf col = arr(4) Then
                    For Each othr In arr
                        ActiveSheet.Cells(rw.Row, othr).Interior.Color = RGB(255, 255, 255)
                    Next othr
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(255, 255, 0)
                    ActiveSheet.Cells(rw.Row, col).Interior.Color = RGB(255, 255, 0)
                End If
            End If
        Next col
    Next rw
End Sub


VBA Code: 
Option Base 1
Sub rudogg_CopyPaste() '' this will colour the the result alone
    Dim arr As Variant
    arr = Array(Columns("CZ").Column, Columns("DC").Column, Columns("DF").Column, Columns("DI").Column)  '' change columns here as per requirements
    For Each rw In Selection.Cells
        For Each col In arr
            If col = rw.Column Then
                ActiveSheet.Range("B" & rw.Row) = rw
                If col = arr(1) Then
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(255, 0, 0)
                ElseIf col = arr(2) Then
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(0, 255, 255)
                ElseIf col = arr(3) Then
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(0, 255, 0)
                ElseIf col = arr(4) Then
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(255, 255, 0)
                End If
            End If
        Next col
    Next rw
End Sub
 
Last edited:
Upvote 0
ouvay said:
Hi

Hope I've understood it correctly... but to be sure, I'm posting two options

have a look

VBA Code: 
Option Base 1
Sub rudogg_CopyPaste() '' this will colour the the source and the pasted result (hopefully this will help to understand where the values are coming from)
    Dim arr As Variant
    arr = Array(Columns("CZ").Column, Columns("DC").Column, Columns("DF").Column, Columns("DI").Column)  '' change columns here as per requirements
    For Each rw In Selection.Cells
        For Each col In arr
            If col = rw.Column Then
                ActiveSheet.Range("B" & rw.Row) = rw
                If col = arr(1) Then
                    For Each othr In arr
                        ActiveSheet.Cells(rw.Row, othr).Interior.Color = RGB(255, 255, 255)
                    Next othr
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(255, 0, 0)
                    ActiveSheet.Cells(rw.Row, col).Interior.Color = RGB(255, 0, 0)
                ElseIf col = arr(2) Then
                    For Each othr In arr
                        ActiveSheet.Cells(rw.Row, othr).Interior.Color = RGB(255, 255, 255)
                    Next othr
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(0, 255, 255)
                    ActiveSheet.Cells(rw.Row, col).Interior.Color = RGB(0, 255, 255)
                ElseIf col = arr(3) Then
                    For Each othr In arr
                        ActiveSheet.Cells(rw.Row, othr).Interior.Color = RGB(255, 255, 255)
                    Next othr
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(0, 255, 0)
                    ActiveSheet.Cells(rw.Row, col).Interior.Color = RGB(0, 255, 0)
                ElseIf col = arr(4) Then
                    For Each othr In arr
                        ActiveSheet.Cells(rw.Row, othr).Interior.Color = RGB(255, 255, 255)
                    Next othr
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(255, 255, 0)
                    ActiveSheet.Cells(rw.Row, col).Interior.Color = RGB(255, 255, 0)
                End If
            End If
        Next col
    Next rw
End Sub


VBA Code: 
Option Base 1
Sub rudogg_CopyPaste() '' this will colour the the result alone
    Dim arr As Variant
    arr = Array(Columns("CZ").Column, Columns("DC").Column, Columns("DF").Column, Columns("DI").Column)  '' change columns here as per requirements
    For Each rw In Selection.Cells
        For Each col In arr
            If col = rw.Column Then
                ActiveSheet.Range("B" & rw.Row) = rw
                If col = arr(1) Then
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(255, 0, 0)
                ElseIf col = arr(2) Then
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(0, 255, 255)
                ElseIf col = arr(3) Then
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(0, 255, 0)
                ElseIf col = arr(4) Then
                    ActiveSheet.Range("B" & rw.Row).Interior.Color = RGB(255, 255, 0)
                End If
            End If
        Next col
    Next rw
End Sub
Click to expand...
Sorry for the delay! I was out of the office. Both of these options throw the debug error on this. the only thing I modified was the changing col B to col W


1667489195997.png
 
Upvote 0
It only seems to be erroring out when I select something in column CZ. the other 3 columns are working properly...
 
Upvote 0
Found the issue. the first array needs to start with 0
If col = arr(0) Then

Works like a charm now!

Thank you so much for your help.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Question
VBA column print hyperlinks
2
Replies
10
Views
216
Micron
M
A
  • Question
VBA Userform List Box to Populate upon entering a specific text in Column B, copy data upon selection and paste data in the same Row in another Column
Replies
3
Views
186
arijitirf
A
S
  • Question
VBA Copy range of data from multiple sheets & paste into single column of summary sheet
Replies
1
Views
464
Micron
M
C
  • Question
Loop validation, copy output from same range and paste in different ranges
Replies
1
Views
392
RoryA
RoryA
P
  • Question
Trying to create Macro that will continuously copy and paste data from a drop down list
Replies
0
Views
196
psywagon
P

Forum statistics

Threads
1,215,042
Messages
6,122,810
Members
449,095
Latest member
m_smith_solihull

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top