Macro to copy data under appropriate heading

Hi,

I've attached a spreadsheet of what I'm working on. I have 2 tabs, "Sheet 1" (which is where I want to execute the macro) and "How it should look like" (after the macro has been executed).

I'm trying to create a macro that copies range A18:A20 under the appropriate heading date in "Sheet1". For example, if the month is September 2013, I want it to copy the cells into C2:C3.

You might ask why I'm not using a lookup function. The reason is that this is only a small scale example of what I'm working on. At the start of every new month, cell A17 is going to change, but I still want to be able to have previous months' records. So for example, in October, cell A17 will be October 2013, but I still want to keep September's values. Like I said, this is a really simplified example of what I'm working on.

The script I'm working on is shown below. I've just started playing around with VBA a few days ago, so this is all sort of new to me. Any assistance as to what I'm doing wrong would be appreciated.

Sub CopyPaste()
Dim I As Integer
I = 1
If Cells(1, I).Value <> Range("A17").Value Then
I = I + 1
ElseIf Cells(1, I).Value = Range("A17").Value Then
Range("A18:A20").Copy
Cells(2, I).PasteSpecial
End If
End Sub

Thanks

Sample.xlsx

anthony_91,

Thanks for the workbook.

Here is an update to your macro with code line explanations:

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub CopyPasteV2()
' stanleydgromjr, 08/01/2013
' http://www.excelforum.com/excel-programming-vba-macros/944072-macro-to-copy-data-under-appropriate-heading.html
'
' instead of using Integer, try using Long
' lc is used to find the laste used column in row 1


' i is a loop counter
Dim lc As Long, i As Long


With Sheets("Sheet1")


  ' lc is used to find the last used column in row 1
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
 
 
  ' loop from column A = 1, to the last column in row 1
  '   Step 1 says to increment i by 1 each loop
  For i = 1 To lc Step 1

  
    '  if the values are not equal 'do nothing
    If Cells(1, i).Value <> Range("A17").Value Then
      'do nothing

      
    '  if the valuse are equal, then copy and PasteSpeical
    ElseIf Cells(1, i).Value = Range("A17").Value Then
      .Range("A18:A20").Copy
      .Cells(2, i).PasteSpecial

      
      '  after copy and paste
      '    stop looping, and, exit the Sub
      Exit Sub


    End If
  Next i
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CopyPasteV2 macro.



The following macro is much faster because it does not loop thru the columns in row 1, one column at a time, and, it does some error checking.

Range("A18:A20") does not contain formulae.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub CopyPasteV3()
' stanleydgromjr, 08/01/2013
' http://www.excelforum.com/excel-programming-vba-macros/944072-macro-to-copy-data-under-appropriate-heading.html
Dim fc As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
  fc = 0
  On Error Resume Next
  fc = Application.Match(.Cells(17, 1), .Rows(1), 0)
  On Error GoTo 0
  If fc = 0 Then
    Application.ScreenUpdating = True
    MsgBox "The date in cell A17 can not be found in row 1 - macro terminated!!!!!"
    Exit Sub
  ElseIf fc > 0 Then
    .Range("A18:A20").Copy Destination:=.Cells(2, fc)
  End If
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CopyPasteV3 macro.

anthony_91,

You are very welcome. Glad I could help.

Thanks for the feedback.

And, come back anytime.