Macro para buscar y ordenar datos horizontal

Si he entendido bien la cuestión, utilizando filtros ya podrás conseguir tus tablas.

Para tu ejemplo, filtrando la columna N por "BACILOSCOPIA MUESTRA 1" y la columna O por "BACILOSCOPIA 1" ya obtendrías el listado

En realidad, no necesito ver la columna filtrada, necesito cruzar diferentes datos que están en O (test), siendo estas de la misma persona, por eso los necesito en forma horizontal cada dato de la persona

¿Todas las personas realizan los mismos tests? (Ni más ni menos)

¿Me puedes dar la lista?

puede haber algunos más en ciertas personas (cuando hay un caso positivo o en tratamiento), la totalidad de test es la siguiente: 
muestra
solicitado
antecedentes
meses
factor
numero
calidad
baciloscopia 1(2)
observacion 1(2)
domicilio
en realidad necesito cruzar solo los tres valores de la imagen dos: BAciloscopia 1, solicitado y calidad.
gracias

Te envío el código con el que verás la luz :-)

Sub bacilo()
Dim MyRing As Range
Dim MyCell As Variant
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Aux1"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Resultados"
Worksheets("Resultados").Range("A1:M1").Value = Worksheets("Hoja1").Range("B1:N1").Value
Worksheets("Resultados").Range("N1").Value = "BACILOSCOPIA 1"
Worksheets("Resultados").Range("O1").Value = "SOLICITADO"
Worksheets("Resultados").Range("P1").Value = "CALIDAD"
Sheets("Hoja1").Select
Range("D2:D10000").Select
Selection.Copy
Sheets("Aux1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Columns("A:A").Select
ActiveSheet.Range("$A$1:$A$10000").RemoveDuplicates Columns:=1, Header:=xlNo
Set MyRing = Range("A1").CurrentRegion
Sheets("Hoja1").Select
Range("B1:P1").Select
Selection.AutoFilter
For Each MyCell In MyRing
Sheets("Hoja1").Select
ActiveSheet.Range("$B$1:$P$10000").AutoFilter Field:=3, Criteria1:=MyCell
ActiveSheet.Range("$B$1:$P$10000").AutoFilter Field:=14, Criteria1:=Array( _
        "BACILOSCOPIA 1", "CALIDAD", "SOLICITADO"), Operator:=xlFilterValues
Range("$P$2:$P$10000").Select
Selection.Copy
Sheets("Resultados").Select
Range("N1").Select
Do
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value = ""
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Sheets("Hoja1").Select
Range("B1").Select
ActiveCell.Offset(1, 0).Activate
Do Until Selection.EntireRow.Hidden = False
If Selection.EntireRow.Hidden = True Then
ActiveCell.Offset(1, 0).Activate
End If
Loop
Application.CutCopyMode = False
Range(ActiveCell, Cells(ActiveCell.Row, 14)).Select
Selection.Copy
Sheets("Resultados").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
Next
Sheets("Aux1").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

¡Gracias! lo probaré y te aviso

este fue mi resultado al probar la macro

veré que esta repetido, comprobando los datos originales, de todas formas estoy agradecido con la ayuda y si me orientas a mejorar mucho mejor 

Tengo la impresión de que para un mismo paciente se realizan varias veces la misma prueba, por eso sale este resultado, ¿es posible?

se pueden repetir los test en el examen "Baciloscopia muestra 2", pero no en el examen "Baciloscopia muestra 1", es decir, en ambos hay un test "Baciloscopia", un "calidad" un "solicitado", etc. Se comprende?

Añade esta línea:

ActiveSheet.Range("$B$1:$P$10000").AutoFilter Field:=13, Criteria1:="BACILOSCOPIA MUESTRA 1"

entre estas dos:

ActiveSheet.Range("$B$1:$P$10000").AutoFilter Field:=3, Criteria1:=MyCell
ActiveSheet.Range("$B$1:$P$10000").AutoFilter Field:=14, Criteria1:=Array( _
        "BACILOSCOPIA 1", "CALIDAD", "SOLICITADO"), Operator:=xlFilterValues

y me cuentas

he revisado y cambie la forma de filtrar, estaba filtrando los nombre y esos se pueden repetir entre cada paciente con diferentes apellidos, por lo tanto, lo cambie por numero de atención el número de atención (folio) y de ahi generar el listado, sin embargo en el momento de pegar el resto de los datos se me genera una espera enorme hasta que logra copiar los datos en la hoja (lo probé paso a paso). Estoy probando con el archivo completo de datos ver su resultado, el cual me esta resultando. Te avisaré resultado final.