Macro para copiar rango y escribir fecha, reemplazando los datos si la fecha ya existe.

Veamos si puedo ayudarte a mejorar y optimizar la macro para cumplir con tus requerimientos. A continuación, te proporciono el código modificado que copiará los datos de los rangos "I2:J16" y "K2:K16" en la hoja "Histórico", reemplazando los datos si la fecha actual ya existe en la columna "B":

Sub CopiarDatosAHistorico()
    Application.ScreenUpdating = False
    Dim origen1 As Range
    Dim origen2 As Range
    Dim destino1 As Range
    Dim destino2 As Range
    Dim fecha As Date
    Dim celda As Range
    Dim hojaHistorico As Worksheet
    Dim protegida As Boolean
    ' Desproteger la hoja "Histórico" si está protegida
    Set hojaHistorico = ThisWorkbook.Sheets("Histórico")
    If hojaHistorico.ProtectContents Then
        protegida = True
        hojaHistorico.Unprotect
    End If
    ' Definir el rango de origen 1 en la hoja "Turnos"
    Set origen1 = Sheets("Turnos").Range("I2:J16")
    ' Definir el rango de origen 2 en la hoja "Turnos"
    Set origen2 = Sheets("Turnos").Range("K2:K16")
    ' Definir el rango de destino 1 en la hoja "Histórico"
    Set destino1 = hojaHistorico.Range("F" & hojaHistorico.Rows.Count).End(xlUp).Offset(1)
    ' Definir el rango de destino 2 en la hoja "Histórico"
    Set destino2 = hojaHistorico.Range("D" & hojaHistorico.Rows.Count).End(xlUp).Offset(1)
    ' Verificar si la fecha actual ya existe en la columna "B" de la hoja "Histórico"
    fecha = Date
    For Each celda In hojaHistorico.Range("B2:B" & hojaHistorico.Cells(Rows.Count, "B").End(xlUp).Row)
        If celda.Value = fecha Then
            destino1.Resize(origen1.Rows.Count).ClearContents
            destino2.Resize(origen2.Rows.Count).ClearContents
            Exit For
        End If
    Next celda
    ' Escribir la fecha actual en la siguiente celda vacía de la columna "B"
    hojaHistorico.Range("B" & hojaHistorico.Cells(Rows.Count, "B").End(xlUp).Row + 1).Value = fecha
    ' Copiar y pegar los valores del rango 1
 origen1. Copy
 destino1. PasteSpecial xlPasteValues
    ' Copiar y pegar los valores del rango 2
 origen2. Copy
 destino2. PasteSpecial xlPasteValues
    ' Limpiar el portapapeles
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    ' Volver a proteger la hoja "Histórico" si estaba protegida
    If protegida Then
        hojaHistorico.Protect
    End If
    Sheets("Turnos").Select
End Sub

Esta versión modifica el código anterior agregando un bucle para verificar si la fecha actual ya existe en la columna "B" de la hoja "Histórico". Si la fecha ya está presente, se eliminan los datos de los rangos.

Muchas ¡Gracias! por el tiempo dedicado a ayudarme.

He probado la macro, desafortunadamente, aún no hace lo que requiero. Como ves, pese a que en la columna "B", ya existe la fecha 19/05/2023, no reemplaza la información, sino que, agrega los datos, repitiendo lo que ya está.

En la macro que generosamente me ayudaste a optimizar, no está buscando y comparando si la fecha existe para reemplazar, también está poniendo una (1) vez la fecha asi ya exista y pues mi intención es que, todas las celdas de las filas copiadas (siempre serán 15 filas), todas tengan la fecha del día que se realiza el pegado.

Tal vez, por ese detalle, no esté logrando aún hacer lo que requiero.

Sub CopiarDatosAHistorico()
    Application.ScreenUpdating = False
    Dim origen1 As Range
    Dim origen2 As Range
    Dim destino1 As Range
    Dim destino2 As Range
    Dim fecha As Date
    Dim celda As Range
    Dim hojaHistorico As Worksheet
    Dim protegida As Boolean
    ' Desproteger la hoja "Histórico" si está protegida
    Set hojaHistorico = ThisWorkbook.Sheets("Histórico")
    protegida = hojaHistorico.ProtectContents
    If protegida Then
        hojaHistorico.Unprotect
    End If
    ' Definir el rango de origen 1 en la hoja "Turnos"
    With Sheets("Turnos")
        Set origen1 = .Range("I2:J16")
        Set origen2 = .Range("K2:K16")
    End With
    ' Definir el rango de destino 1 en la hoja "Histórico"
    With hojaHistorico
        Set destino1 = .Range("F" & .Rows.Count).End(xlUp).Offset(1)
        Set destino2 = .Range("D" & .Rows.Count).End(xlUp).Offset(1)
    End With
    ' Verificar si la fecha actual ya existe en la columna "B" de la hoja "Histórico"
    fecha = Date
    For Each celda In hojaHistorico.Range("B2:B" & hojaHistorico.Cells(hojaHistorico.Rows.Count, "B").End(xlUp).Row)
        If celda.Value = fecha Then
            destino1.Resize(origen1.Rows.Count).ClearContents
            destino2.Resize(origen2.Rows.Count).ClearContents
            Exit For
        End If
    Next celda
    ' Escribir la fecha actual en todo el rango de la columna "B" correspondiente a los datos copiados
    With hojaHistorico
        .Range("B" & destino1.Row).Resize(origen1.Rows.Count).Value = fecha
    End With
    ' Copiar y pegar los valores del rango 1
    origen1.Copy
    destino1.PasteSpecial xlPasteValues
    ' Copiar y pegar los valores del rango 2
    origen2.Copy
    destino2.PasteSpecial xlPasteValues
    ' Limpiar el portapapeles
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    ' Volver a proteger la hoja "Histórico" si estaba protegida
    If protegida Then
        hojaHistorico.Protect
    End If
    Sheets("Turnos").Select
End Sub

En esta parte de código, se corrigió el tema de las fechas en el rango de datos copiados, pero lo que no logro es que, busque si la fecha en que se copia ya existe y si existe, entonces empiece a reemplazar desde la fila donde aparezca la primera fecha del día en que se pegan los datos.

Todavía me genera duplicidad en el pegado.

Creo que de esta manera se logra hacer lo que necesito, eso si, no sé, si haya una forma más optimizada de hacerlo, más rápida o mejor, para que la macro no se demore tanto. 

Sub CopiarDatosAHistorico()
    Application.ScreenUpdating = False
    Dim origen1 As Range
    Dim origen2 As Range
    Dim destino1 As Range
    Dim destino2 As Range
    Dim fecha As Date
    Dim celda As Range
    Dim hojaHistorico As Worksheet
    Dim protegida As Boolean
    ' Desproteger la hoja "Histórico" si está protegida
    Set hojaHistorico = ThisWorkbook.Sheets("Histórico")
    protegida = hojaHistorico.ProtectContents
    If protegida Then
        hojaHistorico.Unprotect
    End If
    ' Definir el rango de origen 1 en la hoja "Turnos"
    With Sheets("Turnos")
        Set origen1 = .Range("I2:J16")
        Set origen2 = .Range("K2:K16")
    End With
    ' Definir el rango de destino 1 en la hoja "Histórico"
    With hojaHistorico
        ' Buscar la primera aparición de la fecha de hoy en la columna "B"
        Set destino1 = .Range("B:B").Find(Date, LookIn:=xlValues, LookAt:=xlWhole)
        ' Si la fecha existe, seleccionar la columna "F" a partir de la primera aparición del día
        ' Si no existe, seleccionar la siguiente celda vacía en la columna "F"
        If Not destino1 Is Nothing Then
            Set destino1 = .Range("F" & destino1.Row)
        Else
            Set destino1 = .Range("F" & .Rows.Count).End(xlUp).Offset(1)
        End If
        Set destino2 = .Range("D" & destino1.Row)
    End With
    ' Verificar si la fecha de hoy ya existe en la columna "B" de la hoja "Histórico"
    fecha = Date
    For Each celda In hojaHistorico.Range("B:B")
        If celda.Value = fecha Then
            ' Limpiar los datos en las columnas "D", "F" y "G" desde la celda de la fecha encontrada
            If hojaHistorico.Range("E" & celda.Row).Value = "" Then
                hojaHistorico.Range("D" & celda.Row & ":G" & celda.Row).ClearContents
            End If
        End If
    Next celda
    ' Escribir la fecha actual en todo el rango de la columna "B" correspondiente a los datos copiados
    With hojaHistorico
        .Range("B" & destino1.Row).Resize(origen1.Rows.Count).Value = fecha
    End With
    ' Copiar y pegar los valores del rango 1
    origen1.Copy
    destino1.PasteSpecial xlPasteValues
    ' Copiar y pegar los valores del rango 2
    origen2.Copy
    destino2.PasteSpecial xlPasteValues
    ' Limpiar el portapapeles
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    ' Volver a proteger la hoja "Histórico" si estaba protegida
    If protegida Then
        hojaHistorico.Protect
    End If
    Sheets("Turnos").Select
End Sub