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

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
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

M
  • Question Question
Macro code to copy & paste cell data
Replies
1
Views
151
Maverick27
M
S
  • Question Question
Need a way to copy and paste previous rows after a dropdown selection is made on the same sheet
2
Replies
12
Views
143
Candyman8019
C
C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
1K
Micron
M
L
  • Question Question
Selection based on two variables - copy and paste to another sheet
Replies
3
Views
396
kvsrinivasamurthy
K
M
  • Question Question
[VBA]Copy data from specify cell and input value to another sheet with time stamp
Replies
2
Views
444
maiwarits
M

Forum statistics

Threads
1,224,885
Messages
6,181,574
Members
453,055
Latest member
cope7895

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