Visual Basic para Aplicaciones - vba no me permite pegar a un destino

Buenos días,
Estimados, quisiera realizar una consulta a la comunidad, vengo trabajando en este código y me he quedado trabado en este punto ya más de 2 días, he realizado consultas e investigado en internet para poder absolver la duda pero aún no he podido.

Necesito, copiar de una hoja una cierta información y pegarla en otra. El código a continuación no se ejecuta, se detiene en la línea en negrita y aún no se porque.

Agradecería que me puedan ayudar con alguna breve explicación del motivo o solución. Muchas gracias.


Sub extracciondetc()

Dim r1, r2, c1, c2, c3 As String
Dim n1, n2, mod1, mod2 As String

r1 = Sheets("Hoja2").Cells.Find("MONEDA").Row
c1 = Sheets("Hoja2").Cells.Find("MONEDA").Column
c2 = Sheets("Hoja2").Cells.Find("TC").Column
c3 = Sheets("Hoja1").Cells.Find("TC").Column
c = 0

Do While Sheets("Hoja2").Cells(r1, 1).Value <> Empty

If UCase(Cells(r1, c1).Value) = "USD" Then
mod2 = UCase(Sheets("Hoja2").Cells(r1, 4).Value)
n2 = Sheets("Hoja2").Cells(r1, c1).Offset(0, -2).Value
r2 = Sheets("Hoja1").Cells.Find(n2, searchorder:=xlColumns).Row
mod1 = Sheets("Hoja1").Cells(r2, 4).Value

If mod1 = mod2 Then
Sheets("Hoja2").Cells(r1, c2).Copy
Sheets("Hoja1").Cells(r2, c3).Paste
Else
MsgBox n2
Cells(r1, c1).EntireRow.Select
Selection.Interior.Color = vbGreen
c = c + 1
End If
End If
r1 = r1 + 1
Loop

MsgBox "Existen " & c & " errores"

End Sub

Hola,
Mira este link https://docs.microsoft.com/es-es/office/vba/api/excel.range.copy].

Sin probar la macro en tu libro es muy difícil adivinar que esta pasando.
Sube el libro.

Saludos.
\\//_