Adicionar instrucción a macro según nueva condición

H o l a:

Te anexo la macro actualizada

Sub Buscar4()
    Set h2 = Sheets("AGENDA")
    Set h3 = Sheets("REAGENDAR")
    Set h4 = Sheets("HISTORIA")
    h3.[D6:D22].ClearContents
    '
    If h3.[D4] = "" Then
        MsgBox "Número de Registro Único (RU) de la cita está VACIO." & vbCrLf & "" & vbCrLf & "Por favor escriba el número de RU en el espacio correspondiente.", vbExclamation
        [D4].Select
        Exit Sub
    End If
    '
    Set b = h2.Columns("R").Find(h3.[D4], lookat:=xlWhole)
    If Not b Is Nothing Then
        h3.[D6] = h2.Cells(b.Row, "B")
        h3.[D7] = h2.Cells(b.Row, "C")
        h3.[D8] = h2.Cells(b.Row, "D")
        h3.[D9] = h2.Cells(b.Row, "E")
        h3.[D10] = h2.Cells(b.Row, "F")
        h3.[D11] = h2.Cells(b.Row, "G")
        h3.[D12] = h2.Cells(b.Row, "H")
        h3.[D13] = h2.Cells(b.Row, "I")
        h3.[D14] = h2.Cells(b.Row, "J")
        h3.[D15] = h2.Cells(b.Row, "K")
        h3.[D16] = h2.Cells(b.Row, "L")
        h3.[D17] = h2.Cells(b.Row, "M")
        h3.[D18] = h2.Cells(b.Row, "N")
        h3.[D19] = h2.Cells(b.Row, "O")
        h3.[D20] = h2.Cells(b.Row, "P")
        h3.[D21] = h2.Cells(b.Row, "Q")
        h3.[D22] = h2.Cells(b.Row, "A")
        If h3.[D6] <= Date Then
            MsgBox "Lamentablemente el sistema solo permite reagendar citas mínimo con " & _
                   "24 horas de anticipación a la cita programada. " & vbCr & vbCr & _
                   "Si necesita registrar una nueva cita para este paciente, " & _
                   "favor dirijase a la sección de INGRESAR CITA. Gracias. ", vbInformation
            'nuevas instrucciones aqui
            u4 = h4.Range("R" & Rows.Count).End(xlUp).Row + 1
            H2. Range(h2. Cells(b.Row, "A"), h2. Cells(b.Row, "Q")). Copy h4. Cells(u4, "A")
            '
            H3. Activate
            h3.Range("D6:D22").Select
            Selection.ClearContents
            h3.Range("D4").Select
            Selection.ClearContents
            ActiveWorkbook.Save
    End If
 Else
        MsgBox "El número de Registro Único (RU) no existe en la AGENDA." & vbCrLf & "" & vbCrLf & "Por favor verifique e Intentelo de nuevo.", vbExclamation
        [D4].Select
    End If
End Sub

s a l u d o s

Que pena Dante en la pregunta se me olvidó ponerte que adicional en la columna "R" de la hoja "Historial" me pusiera la fecha en formato "dd-mmm-aa" en la cual esa fila fue copiada.

Que pena de verdad se me olvido.

No te preocupes, si esa columna va a contener fechas, basta con que le cambies el formato directamente en la hoja en la columna fecha, y ese formato se mantendrá.

Ok Dante pero como es la instrucción para que ponga la fecha en la columna "R".