Code to copy column in sheet 1 to column in sheet 2 based on matched criteria
 

Hello all,

I have a fairly simple code below that's missing one critical step. Currently, it wants to copy the data to the first blank column it finds in the target sheet. What I want to do is have it copy data to the column in the target sheet that matches the range in the source sheet. So, if the source sheet is identified as the "June" month column, I'd like the data to be copied to "June" month column in the target sheet. Can anyone help out....thanks,
Steve

Sub CopyDataToPlan()
Dim LMonth As String
Dim LRow As Integer
Dim LFound As Boolean
'Retrieve date value to search for
LDate = Sheets("Month & YTD vs. Budget").Range("E10").Value
Sheets("Monthly Trend").Select
'Start at Row 15
LRow = 15
LFound = False
While LFound = False
'Found match in row 15
If Cells(15, LRow) = LMonth Then
'Select values to copy from "Month & YTD vs. Budget" sheet
Sheets("Month & YTD vs. Budget").Select
Range("C20:C188").Select
Selection.Copy
'Paste onto "Monthly Trend" sheet
Sheets("Monthly Trend").Select
Cells(17, LRow).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
LFound = True
MsgBox "The data has been successfully copied."
'Continue searching
Else
LRow = LRow + 1
End If
Wend
On Error GoTo 0
Exit Sub
Err_Execute:
MsgBox "An error occurred."

End Sub

Hello skitsoni,

I commented few rows from your code and added 3 rows.
Try this with a copy of your original files so that it doesnt cause any harm
if this doesnt work. Hopefully you will get some help from this.
Here is the changed code.

Sub CopyDataToPlan()

'Hello all,
'I have a fairly simple code below that's missing one critical step.
'Currently, it wants to copy the data to the first blank column it finds in the target sheet.
'What I want to do is have it copy data to the column in the target sheet that matches the range in the source sheet.
'So, if the source sheet is identified as the "June" month column,
'I 'd like the data to be copied to "June" month column in the target sheet.
'
'Can anyone help out....thanks,
'Steve

Dim LMonth As String
Dim LRow As Integer
Dim LFound As Boolean

'Retrieve date value to search for
LDate = Sheets("Month & YTD vs. Budget").Range("E10").Value
Sheets("Monthly Trend").Select

'Start at Row 15
LRow = 15
LFound = False

While LFound = False
'Found match in row 15

If Cells(15, LRow) = LMonth Then
'Select values to copy from "Month & YTD vs. Budget" sheet
Sheets("Month & YTD vs. Budget").Range("C20:C188").Copy
'Paste onto "Monthly Trend" sheet
Sheets("Monthly Trend").Select
' I SUPPOSE THAT YOUR MONTH-VALUES ( LMonth ) ARE AT ROW 17 IN THE TARGET SHEET,
' BECAUSE YOUR CODE SELECTS FIRST CELLS(17,15) AND THEN RISES THE COLUMN-NUMBER
' WHILE SEARCHING THE LMonth - value ( IF - END IF BLOCK )
' FOR EXSAMPLE ( CELLS(17,15), CELLS(17,16), CELLS(17,17), CELLS(17,18) UNTIL
' Lmonth IS FOUND.
' THATS WHY I COMMENTED FOLLOWING ROW AT YOUR CODE AND REPLACED IT WITH FEW ROWS
' THAT TRY TO FIND LMonth FROM ROW 17.
' IF IT IS FOUND, THEN A CELL BELOW IT IS SELECTED.
'
' THEN YOUR CODE CONTINUES WITH
' PASTING VALUES FROM "Month & YTD vs. Budget" - SHEET FROM RANGE("C20:C188")
' TO THE "Monthly Trend" - SHEET.

'Cells(17, LRow).Select ... ( commented row at original code )

' I ALSO COMMENTED SOME UNNECESSARY ROWS FROM YOUR IF - END IF STRUCTURE.

' NEW CODE ***** STARTS HERE ********

Rows("17:17").Select ' at Monthly Trend - sheet
Selection.Find(What:=LMonth, After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Activate ' find and activate LMonth - cell
ActiveCell.Offset(1, 0).Select ' select one cell below found cell and continue with your code

' NEW CODE ******** ENDS HERE ***************


Selection.PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'LFound = True
MsgBox "The data has been successfully copied."
'Continue searching
'Else
'LRow = LRow + 1
End If
Wend
On Error GoTo 0
Exit Sub
Err_Execute:
MsgBox "An error occurred."

End Sub

Best regards