VBA-Copy and paste columns under different headers

[mrpengify]

Hi all, as a newbie, I got a copy-paste problem using VBA. And here is the snapshot of my minimum working environment.

At the end of each month, we will get data for column C and we were supposed to paste Column C data to the green area in order to get the total number.

By using a little bit of Google, what we currently have is:

Sub MonthlyPaste()
    On Error Resume Next
    Dim xRg As Range
    Set xRg = Application.Selection
    Range("C6:C30").Copy Range("G6:G30")
    xRg.Select
End Sub

Notice this is the code for Month 3(M3) button since cell A3 is telling us the date. And we put 12 similar buttons under 12 columns -_-+

That’s quite dumb, isn’t it? What makes things worse is if we clicked the wrong button, the total number will be messed up.

So I am wondering if there is a way to set up one button instead of 12, and copy & paste data from column C to corresponding green columns based on Month(A3)?

Thank you in advance.

 

[bebo021999]

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1
2
3	31-Mar
4	Items	Total	This month
5					Month 1	Month 2	Month 3	Month 4	Month 5	Month 6	Month 7	Month 8	Month 9	Month 10	Month 11	Month 12
6	Item 1	150	100		50	100
7	Item 2	152	200		51	101
8	Item 3	154	300		52	102
9	Item 4	156	400		53	103
10	Item 5	158	500		54	104
11	Item 6	160	600		55	105
Sheet1

Cell Formulas
Range	Formula
B6:B11	B6	=SUM(E6:P6)

With above data, use below single code:

Option Explicit
Sub AddMonth()
Dim ThisMonth
ThisMonth = Range("C6:C" & Cells(Rows.Count, "A").End(xlUp).Row).Value
If IsDate(Range("A3")) Then
    Range("D6").Offset(0, Month(Range("A3"))).Resize(UBound(ThisMonth), 1).Value = ThisMonth
End If
End Sub

 

[Peter_SSs]

That’s quite dumb, isn’t it?

Certainly not the best way in my view.

Assuming that value in A3 is a 'real' date (number) and not text then try this with a copy of your workbook.
Use just a single button for it.

Sub Monthly_Paste()
  Range("C6:C30").Copy Destination:=Range("E6:P6").Cells(Month(Range("A3").Value))
End Sub

 

[mrpengify]

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1
2
3	31-Mar
4	Items	Total	This month
5					Month 1	Month 2	Month 3	Month 4	Month 5	Month 6	Month 7	Month 8	Month 9	Month 10	Month 11	Month 12
6	Item 1	150	100		50	100
7	Item 2	152	200		51	101
8	Item 3	154	300		52	102
9	Item 4	156	400		53	103
10	Item 5	158	500		54	104
11	Item 6	160	600		55	105
Sheet1

Cell Formulas
Range	Formula
B6:B11	B6	=SUM(E6:P6)

With above data, use below single code:

Option Explicit
Sub AddMonth()
Dim ThisMonth
ThisMonth = Range("C6:C" & Cells(Rows.Count, "A").End(xlUp).Row).Value
If IsDate(Range("A3")) Then
    Range("D6").Offset(0, Month(Range("A3"))).Resize(UBound(ThisMonth), 1).Value = ThisMonth
End If
End Sub

Works like a magic! Thanks bebo.

 

[mrpengify]

Certainly not the best way in my view.

Assuming that value in A3 is a 'real' date (number) and not text then try this with a copy of your workbook.
Use just a single button for it.

Sub Monthly_Paste()
  Range("C6:C30").Copy Destination:=Range("E6:P6").Cells(Month(Range("A3").Value))
End Sub

Hi Peter, thanks a lot, that's what exactly I am looking for.

I will modify it a little bit to fit my excel sheet

 

[Peter_SSs]

You're welcome. Glad we could help.