MS Excel 2003: copie el rango de celdas de una hoja a otra que coincida con los valores de fecha

Los datos expuestos en este blog, son solo de índole informativo. Por favor realiza siempre una copia de seguridad antes de realizar cualquier cambio en tu proyecto.

MS Excel 2003: copie el rango de celdas de una hoja a otra que coincida con los valores de fecha

Este tutorial de Excel muestra cómo escribir una macro para copiar un rango de celdas de una hoja de cálculo a otra que coincida con un valor de fecha en Excel 2003 y versiones anteriores (con capturas de pantalla e instrucciones paso a paso).

Problema: En Microsoft Excel 2003/XP/2000/97, quiero crear una macro que copie las celdas B5:H6 de la hoja de Horarios continuos a la ubicación correcta en la hoja de Horarios. La fecha en la celda B4 de la hoja Rolling Schedule debe corresponder a la fecha en la fila 2 de la hoja Schedule.

R: Veamos un ejemplo.

Descargue la hoja de cálculo de Excel (que se muestra a continuación)

En nuestra hoja de cálculo, creamos un botón llamado “Copiar datos” en el cronograma móvil.Cuando el usuario hace clic en este botón, una macro llama Copiar datos al plan se ejecutará. Esta macro buscará el valor de fecha que se encuentra en la celda B4 de la tabla Rolling Schedule e intentará encontrar un valor de fecha coincidente en la tabla Schedule.

Una vez que se encuentra una fecha coincidente, la macro copia los datos de las celdas B5:H6 de la tabla del plan móvil en la ubicación correcta de la tabla del plan.

Cuando se complete la macro, aparecerá el cuadro de mensaje anterior.

Estos valores luego aparecerán en la tabla Programación como se muestra arriba.

Puede presionar Alt+F11 para ver el código VBA.

codigo macro

El código de la macro se ve así:

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