Excel - 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

Ok, lo que entiendo es que a tu macro lo unico que le falta es que solo te busca que repita la operacion y que el resultado que te da es correcto solo que no continua con las demas ordenes , le hice una pequeña modificacion para que repita la operacion

Intenta con esto

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
CellOrden = 9 'Indica la fila de la orden que devera buscar

For Repetir = 1 To Application.WorksheetFunction.CountA([J:J]) - 1 'indica la qty de orenes que devera Buscar

Buscar = Sheets("RESUMEN").Range("J" & CellOrden).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

CellOrden = CellOrden + 1 'Indica que tiene que cambiar la fila a la siguiente por ese motivo se le suma 1 antes de le Next

Next Repetir
End Sub

Slds

Mke

Hola :
Mike, gracias por tu ayuda funciono pero a esto quiero agregarle una condicion mas , que copie pero siempre en cuando los registros en la columna I sean mayor a 0

espero tu ayuda

Atte

Juan Zarate