BUSCAR REGISTRO Y COPIAR TODA LA FILA

AMIGOS:
espero que me ayuden con este problema ,estoy creando una factura necesito buscar 1 registros en otra hoja y si es igual copiar la fila completa
me explico mas claro:
ingreso una ORD VTA en la celda (E23) de la hoja (“FACTURA”) y lo busco en la columna desde B2 en la hoja (“CD-200”) . si es igual copia las siguientes columnas

C2 se copia en B23 de la hoja (“FACTURA”)
D2 se copia en B45 de la hoja (“FACTURA”)
E2 se copia en B20 de la hoja (“FACTURA”)
F2 se copia en B21 de la hoja (“FACTURA”)
G2 se copia en D45 de la hoja (“FACTURA”)
H2 se copia en I22 de la hoja (“FACTURA”)
J2 se copia en B23 de la hoja (“FACTURA”)
K2 se copia en D15 de la hoja (“FACTURA”)

mis tablas son la siguientes:
HOJA (“CD-200”)

A--------------B---------------C----------------D-----------E
1--RUTA-------ORD VTA---COD.CLIENT--SALA---CLIENTES
2---1200---------E0069446----5050.024------ GFRS-----AAAA
3---1200---------E0069446----5050.024------ KIUY.----BBBBB
4---1200---------E0069446----5050.024------ GTRD----CCCCC
5---1201---------E0069394----5000.013------ OIUH-----DDDD
6---1202---------E0069435----5000.041------ GTRF----EEEEE

F----------------------G---------H--------------J----------------K
1--DIR CENT------DIR SUC---GIRO-----FECH.TERM--ORD COMP
2---ZZZZZ-----------ZZOO------GFRS-------16/04/08------EDI-154235
3---NNNN-----------NNHH------KIUY.-- ---16/04/08------EDI-254510
4---KKKK-----------KKIII-------GTRD------16/04/08------EDI-584100
5---LLLLL-----------LLÑÑ------OIUH-------16/04/08------PDA-58141
6---PPPPP------------PPWW----GTRF-------16/04/08------ PDA-58710

HOJA(“FACTURA”)

E
5--ALMACEN
6-----“ “
7-----“ “
8-----“ “
9-----“ “
10---“ “
23—E0069446 o puede ser cualquier otra orden de la tabla (“CD-200”)

el codigo que estoy efectuando es el siguiente pero todavía no me resulta

Sub factura()
'copia los registros de la hoja Hoja2 cuyo mes = celda A1 de la Hoja3
Dim ordvta As String, mes As Integer, mayor As Long
Dim filadestino As Integer, aumenta As Long
Dim ordvtadig As String

filadestino = 2
relacion = 2
For repetir = 1 To Application.WorksheetFunction.CountA([B:B]) - 1
'la variable ordvta indica el codigo de los registros a copiar
ordvta = Sheets("CD-200").Range("B" & relacion).Value
'busca registros cuya codigo es el valor de la variable ordvta
Sheets("FACTURA").Activate
Range("E23").Select
While ActiveCell.Value <> ""
ordvtadig = ActiveCell.Value
If ordvtadig = ordvta Then
Worksheets("CD-200").Cells(filadestino, 3).Copy Destination:=ActiveCell.Offset(0, -3)
Worksheets("CD-200").Cells(filadestino, 4).Copy Destination:=ActiveCell.Offset(0, 22)
Worksheets("CD-200").Cells(filadestino, 5).Copy Destination:=ActiveCell.Offset(-3, -3)
Worksheets("CD-200").Cells(filadestino, 6).Copy Destination:=ActiveCell.Offset(-3, -3)
Worksheets("CD-200").Cells(filadestino, 7).Copy Destination:=ActiveCell.Offset(2, 22)
Worksheets("CD-200").Cells(filadestino, 8).Copy Destination:=ActiveCell.Offset(-1, 4)
Worksheets("CD-200").Cells(filadestino, 10).Copy Destination:=ActiveCell.Offset(0, 4)
Worksheets("CD-200").Cells(filadestino, 11).Copy Destination:=ActiveCell.Offset(-5, 0)

filadestino = filadestino + 1
End If
ActiveCell.Offset(1, 0).Select
Wend
relacion = relacion + 1
Next repetir
Application.CutCopyMode = False
End Sub

espero su ayuda
Atte.
Juan Zarate O

Intenta modificando el final de tu codigo moviendo la ubicacion de filadestino = filadestino + 1, asi :

End If
ActiveCell.Offset(1, 0).Select
Wend
filadestino = filadestino + 1
relacion = relacion + 1
Next repetir
Application.CutCopyMode = False
End Sub

Slds desde mty

Mike

Hola:

tuve que modificar el codigo ya que el anterior con las correcciones que mando Mike ,aun asi no me funciona, no copia nada . les mando todos los datos de nuevo

espero que me ayuden con este problema ,estoy creando una factura necesito buscar 1 registros en otra hoja y si es igual copiar la fila completa
me explico mas claro:
ingreso una ORD VTA en la celda (E23) de la hoja (“FACTURA”) y lo busco en la columna desde B2 en la hoja (“CD-200”) . si es igual copia las siguientes columnas
C2 se copia en B23 de la hoja (“FACTURA”)
D2 se copia en B45 de la hoja (“FACTURA”)
E2 se copia en B20 de la hoja (“FACTURA”)
F2 se copia en B21 de la hoja (“FACTURA”)
G2 se copia en D45 de la hoja (“FACTURA”)
H2 se copia en I22 de la hoja (“FACTURA”)
J2 se copia en B23 de la hoja (“FACTURA”)
K2 se copia en D15 de la hoja (“FACTURA”)

mis tablas son la siguientes:
HOJA (“CD-200”)

A----------------B----------------C------------------D----------E
1--RUTA-------ORD VTA---COD.CLIENT-------SALA---CLIENTES
2---1200---------E0069446----5050.024------ GFRS-----AAAA
3---1200---------E0069446----5050.024------ KIUY.----BBBBB
4---1200---------E0069446----5050.024------ GTRD----CCCCC
5---1201---------E0069394----5000.013------ OIUH-----DDDD
6---1202---------E0069435----5000.041------ GTRF----EEEEE

F----------------------G---------H--------------J------------------K
1--DIR CENT------DIR SUC---GIRO---FECH.TERM--ORD COMP
2---ZZZZZ----------ZZOO------GFRS----16/04/08--------EDI-154235
3---NNNN----------NNHH------KIUY.-- -16/04/08--------EDI-254510
4---KKKK-----------KKIII-------GTRD----16/04/08--------EDI-584100
5---LLLLL----------LLÑÑ------OIUH-----16/04/08--------PDA-58141
6---PPPPP---------PPWW----GTRF----16/04/08-------- PDA-58710

HOJA(“FACTURA”)

E
5--ALMACEN
6-----“ “
7-----“ “
8-----“ “
9-----“ “
10---“ “
23—E0069446 o puede ser cualquier otra orden de la tabla (“CD-200”)

el nuevo codigo que estoy efectuando es el siguiente pero todavía no me resulta
como yo quiero

le he colocado un DO WHILE - LOOP y su recorrido es interminable y no copia nada por eso que le he sacado esta sentencia y ahi recien copia pero solo la 1º fila completa,pero cuando ingreso otra orden de la filas posteriores se queda estancada en la celda inicial y no recorre o busca la orden de la columna B en la hoja("CD-200")

Sub factura()
Dim codigo As Integer, cantidad As Integer, stockantiguo As Integer
Dim numero As String
Dim tipo As String, producto As String, medida As String
'revisamos que los campos esten llenos, sino se envia un mensaje y finaliza la macro
If Range("E23").Value = Empty Then
MsgBox prompt:="ud. esta dejando el campo vacio", Buttons:=vbOKOnly, Title:="DIGITE EL CAMPO"
Exit Sub
End If
'le damos valor a la variable
numero = Range("E23").Value
'comienza la accion,vamos a la otra hoja
'revizamos las celdas con un bucle(do while-loop)para compararlas con
'las variables,para encontrar coincidencias
Sheets("CD-200").Select
Range("B2").Select
'Do While ActiveCell.Value <> Empty
If ActiveCell.Value = numero Then
ActiveCell.Offset(0, 1).Select
codcli = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
sala = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
razonsoc = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
dircent = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
dirsuc = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
giro = ActiveCell.Value
ActiveCell.Offset(0, 2).Select
fechterm = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
ordcomp = ActiveCell.Value
Sheets("FACTURA").Select
Range("E23").Select
'Do While ActiveCell <> Empty
ActiveCell.Offset(0, -3).Value = codicli
ActiveCell.Offset(22, -3).Value = sala
ActiveCell.Offset(-3, -3).Value = razonsoc
ActiveCell.Offset(-2, -3).Value = dircent
ActiveCell.Offset(22, -1).Value = dirsuc
ActiveCell.Offset(-1, 4).Value = giro
ActiveCell.Offset(0, 4).Value = fechterm
ActiveCell.Offset(-7, -1).Value = ordcomp
'Loop
End If
'Loop
End Sub

espero su apoyo

Gracias

Juan Zarate

Hey amigo probe nuevamente el codigo anterior y si copia la informacion el unico detalle que vi era que en el "WorksheetFunction.CountA" faltaba asignarle la hoja a contar . Te anexo el codigo anterior y el nuevo ya modificados y funcionas ya que si me me copian informacion

Pregunta???
Porque en lugar de utilizar tantos "ActiveCell.Offset(0, -3).Value = codicli" no lo asigans directamente asi [B23].Value=codicli

Ojo porque van los dos codigos


Sub factur()
'copia los registros de la hoja Hoja2 cuyo mes = celda A1 de la Hoja3
Dim ordvta As String, mes As Integer, mayor As Long
Dim filadestino As Integer, aumenta As Long
Dim ordvtadig As String

filadestino = 2
relacion = 2
For repetir = 1 To Application.WorksheetFunction.CountA(Sheets("CD-200").[B:B]) - 1
'la variable ordvta indica el codigo de los registros a copiar
ordvta = Sheets("CD-200").Range("B" & relacion).Value
'busca registros cuya codigo es el valor de la variable ordvta
Sheets("FACTURA").Activate
Range("E23").Select
While ActiveCell.Value <> ""
ordvtadig = ActiveCell.Value
If ordvtadig = ordvta Then
Worksheets("CD-200").Cells(filadestino, 3).Copy Destination:=ActiveCell.Offset(0, -3)
Worksheets("CD-200").Cells(filadestino, 4).Copy Destination:=ActiveCell.Offset(0, 22)
Worksheets("CD-200").Cells(filadestino, 5).Copy Destination:=ActiveCell.Offset(-3, -3)
Worksheets("CD-200").Cells(filadestino, 6).Copy Destination:=ActiveCell.Offset(-3, -3)
Worksheets("CD-200").Cells(filadestino, 7).Copy Destination:=ActiveCell.Offset(2, 22)
Worksheets("CD-200").Cells(filadestino, 8).Copy Destination:=ActiveCell.Offset(-1, 4)
Worksheets("CD-200").Cells(filadestino, 10).Copy Destination:=ActiveCell.Offset(0, 4)
Worksheets("CD-200").Cells(filadestino, 11).Copy Destination:=ActiveCell.Offset(-5, 0)

End If
ActiveCell.Offset(1, 0).Select
Wend
filadestino = filadestino + 1
relacion = relacion + 1
Next repetir
Application.CutCopyMode = False
End Sub
----------------------------------------------------------------------------------------------------------------
Sub factura()
Dim codigo As Integer, cantidad As Integer, stockantiguo As Integer
Dim numero As String
Dim tipo As String, producto As String, medida As String
'revisamos que los campos esten llenos, sino se envia un mensaje y finaliza la macro
Sheets("FACTURA").Select
If Range("E23").Value = Empty Then
MsgBox prompt:="ud. esta dejando el campo vacio", Buttons:=vbOKOnly, Title:="DIGITE EL CAMPO"
Exit Sub
End If
'le damos valor a la variable
numero = Range("E23").Value
'comienza la accion,vamos a la otra hoja
'revizamos las celdas con un bucle(do while-loop)para compararlas con
'las variables,para encontrar coincidencias
Sheets("CD-200").Select
cell = 2
Range("B" & cell).Select
Do While ActiveCell.Value <> Empty
If ActiveCell.Value = numero Then
ActiveCell.Offset(0, 1).Select
codicli = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
sala = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
razonsoc = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
dircent = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
dirsuc = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
giro = ActiveCell.Value
ActiveCell.Offset(0, 2).Select
fechterm = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
ordcomp = ActiveCell.Value
Sheets("FACTURA").Select
Range("E23").Select
MsgBox codicli
ActiveCell.Offset(0, -3).Value = codicli
ActiveCell.Offset(22, -3).Value = sala
ActiveCell.Offset(-3, -3).Value = razonsoc
ActiveCell.Offset(-2, -3).Value = dircent
ActiveCell.Offset(22, -1).Value = dirsuc
ActiveCell.Offset(-1, 4).Value = giro
ActiveCell.Offset(0, 4).Value = fechterm
ActiveCell.Offset(-7, -1).Value = ordcomp
End If
Sheets("CD-200").Select
cell = cell + 1
Range("B" & cell).Select
Loop
End Sub

Espero te sirva, tengo el archivo con el que hice las modificaciones si lo quieres me habisas

Slds desde Mty

Mike

hola Mike:
gracias mi amigo todavia no lo he probado , pero acabo de rearmar un codigo diferente , y me ha resultado es mas no solamente me copia los datos del cliente
mas aun los productos que solicita cada orden(en otras palabras he armado una FACTURA).
Aqui les mando el codigo para otros compañeros los puedan probar ya que funciona al 100%

sub factura()
Dim fila1 As Long, redondear As Long
Dim filaA As Integer, filaB As Long, orden As String
Dim fila2 As Long, neto As Long, total As Long, IVA As Long
Worksheets("FACTURA").Range("A1:L22").Value = Empty
Worksheets("FACTURA").Range("A23:D53").Value = Empty
Worksheets("FACTURA").Range("F23:L53").Value = Empty
Sheets("FACTURA").Range("E24:E53").Value = Empty
Worksheets("FACTURA").Activate
Worksheets("FACTURA").Range("A10:M50").Select
If Cells(23, 5).Value = Empty Then
MsgBox prompt:="ud. esta dejando la celda E:23 vacio" & Chr(13) & _
"te lo dice: JUAN ZARATE OBREGON", Buttons:=vbOKOnly, Title:="DIGITE ORDEN EN CELDA E:23"
Cells(23, 5).Select
Exit Sub
End If

orden = UCase(Cells(23, 5))
filaB = 2
While Worksheets("CD-200").Cells(filaB, 2).Value <> ""
filaB = filaB + 1
Wend
columna = 2
For fila2 = 2 To filaB
If Worksheets("CD-200").Cells(fila2, 2).Value = orden Then
Cells(23, 2).Value = Worksheets("CD-200").Cells(fila2, 3).Value
Cells(21, 2).Value = Worksheets("CD-200").Cells(fila2, 6).Value
Cells(16, 4).Value = Worksheets("CD-200").Cells(fila2, 11).Value
Cells(20, 2).Value = Worksheets("CD-200").Cells(fila2, 5).Value
Cells(51, 2).Value = Worksheets("CD-200").Cells(fila2, 4).Value
Cells(51, 4).Value = Worksheets("CD-200").Cells(fila2, 7).Value
Cells(22, 9).Value = Worksheets("CD-200").Cells(fila2, 8).Value
Cells(24, 9).Value = Worksheets("CD-200").Cells(fila2, 10).Value
neto = 0
filaA = 27
For fila1 = 2 To filaB
If Worksheets("CD-200").Cells(fila1, 2).Value = orden Then
Cells(filaA, 1).Value = Worksheets("CD-200").Cells(fila1, 21).Value
Cells(filaA, 4).Value = Worksheets("CD-200").Cells(fila1, 16).Value
Cells(filaA, 5).Value = Worksheets("CD-200").Cells(fila1, 17).Value
Cells(filaA, 6).Value = Worksheets("CD-200").Cells(fila1, 20).Value
Cells(filaA, 8).Value = Worksheets("CD-200").Cells(fila1, 18).Value
redondear = Worksheets("CD-200").Cells(fila1, 19).Value
Cells(filaA, 9).Value = redondear
neto = neto + Cells(filaA, 9).Value
filaA = filaA + 1
End If
Next fila1
fila1 = fila1 + 1
Cells(49, 9).Value = neto
IVA = (Cells(49, 9).Value * 19) / 100
Cells(50, 9).Value = IVA
total = Cells(49, 9).Value + Cells(50, 9).Value
Cells(51, 9).Value = total
End If
fila2 = fila2 + 1
Cells(23, 5).Select
Next fila2

End Sub

mas bien MIKE todo este evento yo quiero que se realize cuando cuando haga ENTER en la celda donde ingreso la orden (E23)
Espero tu ayuda amigo

Atte.

Juan Zarate O