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

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

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
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
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
@ouvay This does exactly what I was looking for! Thank you kindly!
 
Upvote 0
@ouvay This does exactly what I was looking for! Thank you kindly!
I would however, like to point out that in the OP you mentioned that
in either columns C,D or E
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
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 :)
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
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
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

Forum statistics

Threads
1,223,767
Messages
6,174,395
Members
452,561
Latest member
amir5104

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