Copiado Dinamico de celdas

Buenas tares, antes que nada

Tengo una situación con un macro y quisiera un par de opiniones y de su ayuda para resolverla

La macro que intento hacer deber realizar un filtrado de una serie de datos de una hoja y copiarlos a otra

el filtrado se basa en una columna con un dato especifico esa columna es fija siempre va ser la misma, una vez que

hago la búsqueda del dato, cuando lo encuentra realizo el copiado de toda esa fila a otra hoja de excel, el problema

es que también necesito copiar unas celdas hacia abajo pero no siempre es el mismo numero de celdas estas

pueden variar a veces es 1 sola o pueden llegar a ser hasta 4 adjunto el archivo (no el real uno muy parecido)

con la estructura de la base y en la otra hoja el resultado deseado.

Sub Buscad()
Dim LR As Long, i As Long

Dim busca As String
busca = InputBox("Que codigo deseas buscar")
With ActiveSheet
   LR = .Range("K" & Rows.Count).End(xlUp).Row

   For i = 23 To LR
        If .Range("K" & i).Value = busca Then
           .Range("K" & i).EntireRow.Copy
            Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

      End If
    Next i
End With
End Sub[/PHP]

Datos1.rar