Copiar encabezados a nuevas hojas creadas

Hola espero me puedan ayudar tengo el siguiente código:

Sub copiar_y_mover()
columna = Range("bz1").End(xlToLeft).Column
quebusco = UCase(InputBox("Ingrese el dato que desea buscar"))
If quebusco = "" Then Exit Sub
ActiveSheet.Range("a1").CurrentRegion.Sort key1:=Range("a1"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Set busca = ActiveSheet.Range("a1:a" & Range("a1000000").End(xlUp).Row).Find(quebusco, LookIn:=xlValues, lookat:=xlWhole)
If Not busca Is Nothing Then
ubica = busca.Address
Range(ubica).Select
valor = ActiveCell.Value
fila = ActiveCell.Row
contarsi = Application.WorksheetFunction.CountIf(Columns(1), valor)
Range(Cells(fila, 1), Cells(fila + contarsi - 1, columna)).Copy
Application.ScreenUpdating = False
If quebusco = "" Then Exit Sub
For Each hoja In ThisWorkbook.Worksheets
If quebusco = hoja.Name Then
MsgBox "Ya existe una hoja con ese nombre."
Exit Sub
End If
Next
Dim Hoja1 As Worksheet
Set Hoja1 = ActiveWorkbook.Sheets.Add
Hoja1.Name = quebusco
Application.ScreenUpdating = True
Range(Cells(fila, 1), Cells(fila + contarsi - 1)).PasteSpecial xlPasteAll
Application.CutCopyMode = False
End If
End Sub

LO que hace es que busca los datos de la columna a si los encuentra los seleeciona a todos, crea una nueva hoja con ese valor y copia todo lo que encontró ejemplo

En el inputbox colocamos el datos a buscar eduardo y encuentra 5 valore los copia crea una nueva llamada eduardo y pégalos 5 valore que encontró en la hoja eduardo.

Lo que necesito es que también copie y pegue los encabezados en cada nueva hoja que se cree los encabezados son :

USUARIO ROL VALOR NOMBRE APELLIDO CREACIÓN USUARIO ACCESO CORREO

estoy usando la version 2007 y la hoja principal se llama A.DATOS

GRACIAS ESPERO ME PUEDAN AYUDAR.