Office - Comparar columnas y copiar bajo una condicion

Hola :
necesito su ayuda por favor,tengo una hoja( "RESUMEN"),que tienen datos desde la columna A hasta la J
y todas ellas con muchos datos en las filas, y estan ordenadas .lo que quiero es comparar la columna J
con la columna B y si es igual que copie la fila B y A en la columna M y L, asi sucesivamente hasta llegar
a la ultima fila con datos de la columna B
NOTA: la columna J son los datos que necesito encontrar en la columna B
los datos pueden repetirse en la columna B y tambien necesito copiarlo
aqui les mando el codigo que estoy trabajando, y solamente me copia el primer dato que encontre y no los
los siguientes
Sub JUAN()
'copia los registros de la hoja Hoja2 cuyo mes = celda A1 de la Hoja3
Dim Buscar As String, columnass As Integer
Dim Celda As Range
Dim PrimeraCelda As String
columnass = 9
Buscar = Sheets("RESUMEN").Range("J9").Value
'Se va a escribir columna B, los números de filas
'donde se encuentra el dato.
Sheets("RESUMEN").Select
Range("B9").Select
With Worksheets("RESUMEN").Range("B:B")
Set Celda = .Find(Buscar)
If Not Celda Is Nothing Then
PrimeraCelda = Celda.Address
Do
Celda.Copy Destination:=Sheets("RESUMEN").Cells(columnass, 11)
Celda.Offset(0, -1).Copy Destination:=Sheets("RESUMEN").Cells(columnass, 12)
columnass = columnass + 1
Set Celda = .FindNext(Celda)
Loop While Not Celda Is Nothing And Celda.Address <> PrimeraCelda
Range(PrimeraCelda).Select
Else
MsgBox "El valor " & aBuscar & " No fue encontrado en el rango indicado", vbInformation, "Valor no encontrado"
End If
End With
'Baja una celda
ActiveCell.Offset(0, 11).Select
End Sub
----A--------------B--------------C------------E----------------F------------G-------------I------------J-------
FACTURA-ORDEN----CODIGO----CLIENTE—CAPACIDAD-STOCK—EMBAR--ORDEN
F01023----E0073686----411051--5050.001-----48*125------ 1,214-----------20----OV159245
F01023----E0073686----411052--5050.001------48*125------1200------------15----E0073686
F01024----OV159245---413011--5000.002-------10*1---------1440-----------11-----E0068974
E01024----OV159245---413012--5000.002-------10*1---------1550------------13-----P0023046
E01024----OV159245---413014--5000.002-------10*1----------2000-------------18
E01025----P0023046---413016---5018.025--------10*1----------3000-------------19
E01026---E0068974----410648---5010.003------48*125-------3500-------------500
E01027---OV159111---490798---78847160--------6*1----------15500-------------250
E01027---OV159111---490797---78847160--------6*1----------15600-------------232
E01028---OV159159---490800---3008.003--------6*1----------15800------------224
En esta hoja se observa como estan distribuidos los registros, el codigo efectua lo siguiente:
Si la 1º fila de la columna J es igual a B copia la orden y la factura(B y A ) y pega en K y L , pero solo la 1º orden de J mas no los otros,
Osea solo hace esto:
----K---------------L
OV159245—E01024
OV159245—E01024
OV159245—E01024
Y se queda ahí ,no continua con los otros registros que encuentra.como uds veran quedan mas registros en J para comparar y
Copiar en K y L
Por favor , ayúdenme

Atte.

Juan Zarate Obregon

He conseguido copiar los datos a una hoja de calculo y he ejectado la macro y funciona perfectamente.

De hecho hace exactamente lo que le has dicho que haga y no lo que deseas que haga.

Me explico.
¿Que hace la macro? Toma el valor de la celda J9 (el primero de la columna J) Lo busca en la columna B y si lo encuentra copia las celdas de la misma fila de las Columnas A y M a las columnas K y J y para finalizar se desplaza 11 columnas a la derecha.

Y aqui finaliza.

¿Que le falta?

un Bulcle para recorrer toda la columna. Por ejemplo un For aunque seguro que hay otras opciones.

Aqui un extracto:

FOR Colum=9 to 12
Buscar = Sheets("RESUMEN").Range("J"+MID$(STR$(Colum),2)).Value
'Se va a escribir columna B, los números de filas
'donde se encuentra el dato.
......
End If
End With
'Baja una celda
NEXT

OJO : Debes controlo que Busca no tenga un valor vacio es decir hacer esto:

IF not Busca = "" then
With Worksheet . . . .
. . .
end With
ENDIF

Por si no se mete en un bucle infinito. Te pongo la macro con mis cambios

Sub JUAN()
'copia los registros de la hoja Hoja2 cuyo mes = celda A1 de la Hoja3

Dim Buscar As String, columnass As Integer
Dim Celda As Range
Dim PrimeraCelda As String

columnass = 9

For Col = 9 To 12
Buscar = Sheets("RESUMEN").Range("J" + Mid$(Str$(Col), 2)).Value
If Not Busca = "" Then
With Worksheets("RESUMEN").Range("B2:B19")

Set Celda = .Find(Buscar)

If Not Celda Is Nothing Then
PrimeraCelda = Celda.Address
Do
Celda.Copy Destination:=Sheets("RESUMEN").Cells(columnass, 11)
Celda.Offset(0, -1).Copy Destination:=Sheets("RESUMEN").Cells(columnass, 12)
columnass = columnass + 1
Set Celda = .FindNext(Celda)
Loop While Not Celda Is Nothing And Celda.Address <> PrimeraCelda
Range(PrimeraCelda).Select
Else
MsgBox "El valor [" & Buscar & "] No fue encontrado en el rango indicado", vbInformation, "Valor no encontrado"
End If
End With
End If
Next
End Sub

En el for debes cambiar el 12 por el numero de filas que tenga la columna 12
o hacer el bucle hasta que encuentre una celda vacia o ....

Un saludo