Copiar encabezado y contenido parcial a otro libro

Tengo o una tabla con la siguiente estructura

id_dueño tipo elemento marca

1 lavadora XXX

1 TV YYY

2 licudora XXXX

Lo que quiero es generar un libro por cada id_dueño, eso ya lo logré pero ahora quiero agregar el ecabezado a cada planilla y ahí tengo problemas , al parecer pierdo el foco entre el libro destino y el origen...no se bien que pasa, acá mi macro:

Esta funciona bien, pero no se como agregar el encabezado:

Sub crearLibros()
Dim strHoja, strStartHoja, strRuta As String
Dim i As Integer
Dim ultimoCorte As Integer
Dim hoja As Worksheet
Dim localActual As Integer
Application.ScreenUpdating = False
strStartHoja = ActiveCell.Worksheet.Name
'bucle todas hojas
'For i = 1 To Sheets.Count
Range("A2").Select
localActual = ActiveCell.Value
strRuta = "C:\ejemploExcel"
ultimoCorte = 2
Do Until IsEmpty(ActiveCell)
If localActual <> ActiveCell.Value Then
strHoja = "SurtidoLocal_" & localActual
'Copiar
i = ActiveCell.Row
Range("A" & ultimoCorte & ": Z" & ActiveCell.Row - 1).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="C:\ejemploExcel\" & strHoja & ".xls", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
'asigno nuevo local actual
Range("A" & i).Select
localActual = ActiveCell.Value
ultimoCorte = ActiveCell.Row
End If
ActiveCell.Offset(1, 0).Select
Loop
strHoja = "SurtidoLocal_" & localActual
'Copiar
i = ActiveCell.Row
Range("A" & ultimoCorte & ": Z" & ActiveCell.Row - 1).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="C:\ejemploExcel\" & strHoja & ".xls", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets(strStartHoja).Activate
Application.ScreenUpdating = True
End Sub

GRACIAs1111