Problema para terminar código en macro

Pero un poco más de investigación ha dado resultado

Coloco el código que funciona

Sub copiar_celdas_diferentes_pegar_otro_libro()
' abre el siguiente archivo
Archivo = "D:\Jose Ono\Facturas\PLANTILLAS\clientes facturados.xlsx"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Archivo) Then
Workbooks.Open Archivo
' inserta linea en archivo
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With Selection.Font
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Set h1 = ThisWorkbook.ActiveSheet
Set h2 = Workbooks("clientes facturados.xlsx")
h1.Activate
' copia diferentes deldas y las pega en otra celda de otro libro
Range("C7").Copy _
Destination:=Workbooks("clientes facturados.xlsx").Worksheets("hoja1").Range("A2")
Range("C8").Copy _
Destination:=Workbooks("clientes facturados.xlsx").Worksheets("hoja1").Range("B2")
Range("C9").Copy _
Destination:=Workbooks("clientes facturados.xlsx").Worksheets("hoja1").Range("C2")
Range("C10").Copy _
Destination:=Workbooks("clientes facturados.xlsx").Worksheets("hoja1").Range("D2")
Range("H9").Copy _
Destination:=Workbooks("clientes facturados.xlsx").Worksheets("hoja1").Range("E2")
Range("k9").Copy _
Destination:=Workbooks("clientes facturados.xlsx").Worksheets("hoja1").Range("G2")
Range("M5").Copy _
Destination:=Workbooks("clientes facturados.xlsx").Worksheets("hoja1").Range("H2")
Range("J10").Copy
Workbooks("clientes facturados.xlsx").Activate
Range("F2").PasteSpecial
Application.CutCopyMode = False

h1.Activate
' Busca texto "Total Factura" selecciona celda derecha copia y pega otro libro
Cells.Find(What:="Total Factura", After:=ActiveCell, LookIn:=xlFormulas2 _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
Selection.Copy
h2.Activate
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
' Dar formato a la fila donde pegamos los datos
Rows("2:2").Select
With Selection.Font
.Name = "Arial Black"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Name = "Arial Black"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Columns("A:K").Select
Columns("A:K").EntireColumn.AutoFit
Application.WindowState = xlNormal
' Guarda el libro aceptando cambios con los datos pegados
ActiveWorkbook.Save
ActiveWindow.Close

End If
End Sub

Va un poco lento, supongo que no esta optimizado

Si alguien puede ver como agilizarla lo agradezco

Prueba lo siguiente:

Sub copiar_celdas_diferentes_pegar_otro_libro()
  Dim archivo As String
  Dim fso As Object
  Dim wb2 As Workbook
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim f As Range
  '
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  '
  Set sh1 = ThisWorkbook.ActiveSheet
  ' abre el siguiente archivo
  archivo = "D:\Jose Ono\Facturas\PLANTILLAS\clientes facturados.xlsx"
  'archivo = "C:\trabajo\clientes facturados.xlsx"
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(archivo) Then
    Set wb2 = Workbooks.Open(archivo)
    Set sh2 = wb2.Sheets("Hoja1")
    sh2.Rows("2:2").Insert xlDown
    With sh2.Rows("2:2")
      With .Font
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
      End With
      With .Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
    End With
    '
    sh2.Range("A2").Value = sh1.Range("C7").Value
    sh2.Range("B2").Value = sh1.Range("C8").Value
    sh2.Range("C2").Value = sh1.Range("C9").Value
    sh2.Range("D2").Value = sh1.Range("C10").Value
    sh2.Range("E2").Value = sh1.Range("H9").Value
    sh2.Range("G2").Value = sh1.Range("J9").Value
    sh2.Range("F2").Value = sh1.Range("J10").Value
    sh2.Range("H2").Value = sh1.Range("M5").Value
    '
    Set f = sh1.Cells.Find("Total Factura", , xlValues, xlPart, , , False)
    If Not f Is Nothing Then
      'pega en el libro2
      sh2.Range("M2").Value = f.Offset(0, 1).Value
    End If
    wb2.Close True
  End If
End Sub