Copiar fecha en otra hoja

A tod@s:
Os cuento tengo 2 macros, una (FECHA) que me copia la fecha de la hoja "DATOS" a la hoja "RESUMEN" y otra (LANZAR CALCULOS) que me hace una serie de cálculos. La macro FECHA funciona perfectamente si la ejecuto sola, pero al añadirla a la macro (LANZAR CALCULOS) solo me funciona la macro de los cálculos la de fecha no... Y no se como hacerlo para que me funcione solo en una macro las dos operaciones.

FECHA

Sub FECHA()

Dim Celda As Range
Dim PALABRA As String

PALABRA = "*" & "??/??/????" & "*"

For Each Celda In Range("A1:K1")
If Celda.Value Like PALABRA Then
Celda.Select
'VVV = Celda.Address
Celda.Copy
'Worksheets("RESUMEN").Range(VVV).PasteSpecial xlPasteAll
vals = InStr(1, Celda.Value, "/")
vfech = Mid(Celda.Value, vals - 2, 10)
vfech = CDate(vfech)
vdia = Weekday(vfech, 5)
'VR = Cells(3, vdia + 1)
Worksheets("RESUMEN").Cells(3, vdia + 2).PasteSpecial xlPasteAll
End If
Next Celda

End Sub

LANZAR CALCULOS

Sub LanzarCalculos()

Mensaje = MsgBox("Desea borrar los datos existentes", vbQuestion + vbYesNo, "#FreelancerExcel")

If Mensaje = vbYes Then
'Limpiar datos anteriores en la hoja "RESUMEN"
Sheets("RESUMEN").Cells.ClearContents
cRESUMEN = 1
Else
cRESUMEN = Sheets("RESUMEN").Cells(4, Cells.Columns.Count).End(xlToLeft).Column + 1
End If

'Averiguar cual es la última fila de la hoja "DATOS"

uFila = Sheets("DATOS").Cells(Rows.Count, 1).End(xlUp).Row

fRESUMEN = 3

'Bucle para recorrer las filas y buscar las máquinas que tenemos en la columna 3.
For fDATOS = 1 To uFila
If Left(Sheets("DATOS").Cells(fDATOS, 3), 12) = "MOV-RISPACS-" Then
'Poner el nombre en la hoja "RESUMEN"
Sheets("RESUMEN").Cells(fRESUMEN, cRESUMEN) = Sheets("DATOS").Cells(fDATOS, 3)
'Sheets("RESUMEN").Cells(fRESUMEN, cRESUMEN + 1) = "Capacity"
'Localizar datos de esta máquina.
CalcularDatosMaquina2 (fDATOS), (fRESUMEN), (cRESUMEN)
fRESUMEN = fRESUMEN + 7
End If
Next

'Seleccionar la hoja "RESUMEN" para visualizar.
Sheets("RESUMEN").Select
Sheets("RESUMEN").Cells(1, 1).Select

'Si cRESUMEN es diferente de 1 ejecutar los siguiente.
If cRESUMEN <> 1 Then

'Ordenar los datos de acuerdo a las máquinas de la 1ª columna.
'Buscar la 1ª máquina de la columna 1 en la columna actual(cRESUMEN).
For f = 3 To 31 Step 7
If Cells(f, cRESUMEN) = Cells(3, 1) Then
'Si coincide copiamos los datos de la máquina a la fila 38.
Range(Cells(f, cRESUMEN), Cells(f + 5, cRESUMEN + 1)).Copy Cells(3, cRESUMEN + 2)
End If
Next
'Buscar la 2ª máquina de la columna 1 en la columna actual(cRESUMEN).
For f = 3 To 31 Step 7
If Cells(f, cRESUMEN) = Cells(10, 1) Then
'Si coincide copiamos los datos de la máquina a la fila 38.
Range(Cells(f, cRESUMEN), Cells(f + 5, cRESUMEN + 1)).Copy Cells(10, cRESUMEN + 2)
End If
Next
'Buscar la 3ª máquina de la columna 1 en la columna actual(cRESUMEN).
For f = 3 To 31 Step 7
If Cells(f, cRESUMEN) = Cells(17, 1) Then
'Si coincide copiamos los datos de la máquina a la fila 38.
Range(Cells(f, cRESUMEN), Cells(f + 5, cRESUMEN + 1)).Copy Cells(17, cRESUMEN + 2)
End If
Next
'Buscar la 4ª máquina de la columna 1 en la columna actual(cRESUMEN).
For f = 3 To 31 Step 7
If Cells(f, cRESUMEN) = Cells(24, 1) Then
'Si coincide copiamos los datos de la máquina a la fila 38.
Range(Cells(f, cRESUMEN), Cells(f + 5, cRESUMEN + 1)).Copy Cells(24, cRESUMEN + 2)
End If
Next
'Buscar la 5ª máquina de la columna 1 en la columna actual(cRESUMEN).
For f = 3 To 31 Step 7
If Cells(f, cRESUMEN) = Cells(31, 1) Then
'Si coincide copiamos los datos de la máquina a la fila 38.
Range(Cells(f, cRESUMEN), Cells(f + 5, cRESUMEN + 1)).Copy Cells(31, cRESUMEN + 2)
End If
Next
'Borrar las columnas cRESUMEN+2
Sheets("RESUMEN").Range(Cells(1, cRESUMEN), Cells(1, cRESUMEN + 2)).EntireColumn.Delete
End If
End Sub