MS Excel: Copy range of cells from one sheet to another sheet matching on date values in Excel 2003/XP/2000/97

Question: In Excel 2003/XP/2000/97, I would like to create a macro that will copy the cells B5:H6 from the "Rolling Plan" sheet to the correct location in the "Plan" sheet. The date in cell B4 of the "Rolling Plan" sheet should correspond to the date found in row 2 of the "Plan" sheet.

Answer: Let's take a look at an example.

Download Excel spreadsheet (as demonstrated below)

In our spreadsheet, we've created a button on the Rolling Plan sheet called "Copy Data". When the user clicks on this button, a macro called CopyDataToPlan will run. This macro will search for the date value found in cell B4 on the "Rolling Plan" sheet and attempt to find the matching date value on the "Plan" sheet.

When the matching date is found, the macro will copy the data from cells B5:H6 from the "Rolling Plan" sheet to the correct location in the "Plan" sheet.

When the macro has completed, the above message box will appear.

The values will then appear on the "Plan" sheet as shown above.

You can press Alt-F11 to view the VBA code.

Macro Code:

The macro code looks like this:

Sub CopyDataToPlan()

    Dim LDate As String
    Dim LColumn As Integer
    Dim LFound As Boolean

    On Error GoTo Err_Execute

    'Retrieve date value to search for
    LDate = Sheets("Rolling Plan").Range("B4").Value

    Sheets("Plan").Select

    'Start at column B
    LColumn = 2
    LFound = False

    While LFound = False

        'Encountered blank cell in row 2, terminate search
        If Len(Cells(2, LColumn)) = 0 Then
            MsgBox "No matching date was found."
            Exit Sub

        'Found match in row 2
        ElseIf Cells(2, LColumn) = LDate Then

            'Select values to copy from "Rolling Plan" sheet
            Sheets("Rolling Plan").Select
            Range("B5:H6").Select
            Selection.Copy

            'Paste onto "Plan" sheet
            Sheets("Plan").Select
            Cells(3, LColumn).Select
            Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False

            LFound = True
            MsgBox "The data has been successfully copied."

        'Continue searching
        Else
            LColumn = LColumn + 1
        End If

    Wend

    On Error GoTo 0

    Exit Sub

Err_Execute:
    MsgBox "An error occurred."

End Sub