Buscar y pegar

No es necesario que selecciones cada celda que vas a copiar, podes utilizar la expresión:
Offset(fila, col)
Así en tu ejemplo será:
Sheets("xx").range("A4") = Activecell.Offset(0,1)
Sheets("xx").range("A5") = Activecell.Offset(0,2)
'y así con todas, incrementando cada vez el nro de col
Ahora viendo tu ejemplo quizás puedas utilizar la opción de Trasponer del menú Pegado Especial. Atención que si son fórmulas te copiará como fórmula y no como resultado.

Encendé la grabadora, copiá la fila de datos, seleccioná la primer celda de destino y desde menú Edición, Pegado Especial, optá por Transponer.
Apagá la grabadora y en un módulo encontrarás la rutina

En lo del ejemplo muy bien. Pero en lo referente a lo de transponer, bien pero el problema es el siguiente:
Cuando yo busco el dato no se en que fila esta. Las Columnas si se las que me tiene que copiar pero la fila no.
Sub Buscar()
Sheets("Cuerpos Facturas").Activate
On Error GoTo saliendo
Cells.Find(What:=Sheets("Facturas").Range("D17"), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Sheets("Facturas").Range("B1:G1").Select
Selection.Copy
Range("A10").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub
En la macro anterior el problema lo tengo en ("B1:G1"). Pues no se si cuando encuentre el dato la fila va a ser la 1 o la 20. No se si me he explicado con claridad. Gracias por el interés tomado.