Como reducir el tiempo de ejecución de una macro en Excel VBA

Ayuda por favor para reducir el tiempo de ejecución de la siguiente macro.

De antemano, Gracias!

Sub LLENADOEJECUTIVO()
'Macro elaborada por Jorge Cue Perez
Set h1 = Sheets("ciclo_operativo")
Set h2 = Sheets("Ejecutivo")
Msg = MsgBox("Quieres borrar el contenido del reporte ejecutivo?", vbYesNo, "Reporte de Ciclos")
If Msg <> 6 Then
Exit Sub
End If
'h2.Range("A2:AL200000").ClearContents
Dim i As Long
On Error Resume Next
'For i = 1 To Rows.Count
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
h2row = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
If h1.Cells(i, 2) = h1.Cells(i + 1, 2) And Left(h1.Cells(i, 6), 6) = "Planta" And _
(Left(h1.Cells(i + 1, 6), 5) = "Dist." Or Left(h1.Cells(i + 1, 6), 3) = "Bod" Or (Left(h1.Cells(i + 1, 6), 3) = "Tek")) Then
h2.Cells(h2row, 1) = h1.Cells(i, 1)
h2.Cells(h2row, 2) = h1.Cells(i, 2)
h2.Cells(h2row, 3) = h1.Cells(i, 6)
h2.Cells(h2row, 4) = h1.Cells(i + 1, 6)
If h2.Cells(h2row, 4) <> "" Then h2.Cells(h2row, 12) = h1.Cells(i, 19)
If h2.Cells(h2row, 4) <> "" Then h2.Cells(h2row, 13) = h1.Cells(i, 20)
If h2.Cells(h2row, 4) <> "" Then h2.Cells(h2row, 14) = h1.Cells(i + 1, 9)
End If
Next i
End Sub