tech on the net
Home About Us Feedback Site Map

Microsoft

Access Excel Word

Database

SQL Oracle / PLSQL SQL Server MySQL MariaDB PostgreSQL

Web Development

HTML CSS Color Picker

Language

C Language

More

ASCII Table Linux UNIX Java Clipart Joke of the Moment

Other Sites

CheckYourMath BigActivities DigMinecraft
Share this page:

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

Question: In Microsoft 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 look at an example.

Download Excel spreadsheet (as demonstrated below)

Microsoft Excel

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.

Microsoft Excel

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

Microsoft Excel

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
   
   Exit Sub
   
Err_Execute:
   MsgBox "An error occurred."
   
End Sub