Reducir macro que copia datos de una libro a otro

Puedes utilizar las áreas de un rango para pasar todo el rango de celdas, en lugar de hacerlo por celda.

Si en lugar de copiar y pegar, pasas los valores, el proceso será más rápido.

Revisa esta opción:

Sub MetodoAbrirLibro_2()
  Dim wbOr As Workbook, wbDes As Workbook
  Dim ar As Range
  Dim i As Long
  '
  Set wbOr = ThisWorkbook
  Set wbDes = Workbooks.Open("C:\Users\jctorres\Desktop\Programaciones vba\Partes presenciales\C2020-0136_Carga_Horas (1)2.xls")
  With wbOr.Sheets("EPYC1")
    wbDes.Sheets("Personal").Range("A8:F108").Value = .Range("A8:F108").Value
    wbDes.Sheets("Personal").Range("G3").Value = .Range("F2").Value
    wbDes.Sheets("Personal").Range("H3").Value = .Range("I2").Value
  End With
  '
  For i = 1 To 8
    With wbOr.Sheets("EPYC" & i)
      For Each ar In Union(.Range("H2"), .Range("H3"), .Range("l2"), .Range("G8:H108"), .Range("J8:K108"), .Range("M8:M108")).Areas
        wbDes.Sheets("OT" & i).Range(ar.Address).Value = ar.Value
      Next ar
    End With
  Next i
End Sub

¡Gracias! 

Va como un rallo¡¡

Sl2

Pasar valores por áreas en lugar de copiar y pegar celda por celda, es más eficiente.

La macro se puede reducir con el uso de un bucle For ... Next, de este modo:

Sub MetodoAbrirLibro()
Dim rngCopy As Range, rngCopyOT2 As Range, rngOT1 As Range, rngOT2 As Range, cel As Range, cel2 As Range, adres$
Dim wbOr As Workbook, wbDes As Workbook
Dim nombre As String, Ruta As String
Application.ScreenUpdating = False
Set wbOr = ThisWorkbook
Set wbDes = Workbooks.Open("C:\Users\jctorres\Desktop\Programaciones vba\Partes presenciales\C2020-0136_Carga_Horas (1)2.xls")
With wbOr.Sheets("EPYC1")
    . Range("A8:F108"). Copy
    WbDes. Sheets("Personal"). Range("A8:F108"). PasteSpecial xlPasteValues
    . Range("F2"). Copy
    WbDes. Sheets("Personal"). Range("G3"). PasteSpecial xlPasteValues
    . Range("I2"). Copy
    WbDes. Sheets("Personal"). Range("H3"). PasteSpecial xlPasteValues
End With
For i = 1 To 8
    nbreHo1 = "EPYC" & i
    nbreHo2 = "OT" & i
    With wbOr.Sheets(nbreHo1)
        Set rngOT1 = .Range("A:U")
        Set rngCopy = Intersect(rngOT1, Union(.Range("H2"), .Range("H3"), .Range("l2"), .Range("G8:H108"), .Range("J8:K108"), .Range("M8:M108")))
        For Each cel In rngCopy
            wbDes.Sheets(nbreHo2).Range(cel.adres) = cel.Value
            Next cel
        End With
    End With
Next i
Application.CutCopyMode = False
End Sub

Observa que para la hoja EPYC1 la primer parte se mantiene y solo entra al bucle desde la definición del rango 'rngOT1'

Ahora, el tiempo de demora también se debe al modo de copiar/pegar, que vas haciendo celda x celda. Pero no puedo hacer cambios allí ya que desconozco cómo es cada rango (con formato, con fórmulas, combinadas o no, etc).

Buenas , me da un error 438  wbDes.Sheets("nbreHo2").Range(cel.adres) = cel.Value.

Debes copiar el código TAL COMO se te envía:

wbDes.Sheets(nbreHo2).Range(cel.adres) = cel.Value

Cuando se utiliza una variable para indicar el nombre de un libro u hoja, NO va entre comillas.

Sdos!

Si está configurada la opción de exigir la declaración de variables (generalmente ya no la utilizamos), al inicio debes agregar también estas líneas:

Dim i as Byte

Dim nbreHo1 as String, nbreHo2 as String

Sdos. Recuerda que tienes 2 opciones para votar: Buena o Excelente ;)

Elsa

Buenas

Le quite las comillas y declare las variantes y sigue con el mismo error¡¡

Cópiala tal cual:

Sub MetodoAbrirLibro()
Dim rngCopy As Range, rngOT1 As Range, cel As Range, cel2 As Range, adres$
Dim wbOr As Workbook, wbDes As Workbook
Dim nombre As String, Ruta As String
Dim i As Byte
Dim nbreHo1 As String, nbreHo2 As String
Application.ScreenUpdating = False
Set wbOr = ThisWorkbook
Set wbDes = Workbooks.Open("C:\Users\jctorres\Desktop\Programaciones vba\Partes presenciales\C2020-0136_Carga_Horas (1)2.xls")
With wbOr.Sheets("EPYC1")
    . Range("A8:F108"). Copy
    WbDes. Sheets("Personal"). Range("A8:F108"). PasteSpecial xlPasteValues
    . Range("F2"). Copy
    WbDes. Sheets("Personal"). Range("G3"). PasteSpecial xlPasteValues
    . Range("I2"). Copy
    WbDes. Sheets("Personal"). Range("H3"). PasteSpecial xlPasteValues
End With
For i = 1 To 8
    nbreHo1 = "EPYC" & i
    nbreHo2 = "OT" & i
    With wbOr.Sheets(nbreHo1)
        Set rngOT1 = .Range("A:U")
        Set rngCopy = Intersect(rngOT1, Union(.Range("H2"), .Range("H3"), .Range("l2"), .Range("G8:H108"), .Range("J8:K108"), .Range("M8:M108")))
        For Each cel In rngCopy
            adres = cel.Address
            wbDes.Sheets(nbreHo2).Range(adres).FormulaR1C1 = cel.Value
            Next cel
        End With
    End With
Next i
Application.CutCopyMode = False
End Sub

Si te da algún error presioná el botón DEpurar y tomá captura de imagen del Editor para que vea en qué línea se detiene y el mensaje que te devuelve. 

Sdos!

Ahora si que funciona, pero no sigue igual de lento. Sera lo que dijiste sobre copiar y pegar los datos en las celdas.