copiar de una hoja y pegarlo en otra con macro

Hola KM**VE

Mira a ver si te vale este codigo, que seguramente sera muy mejorable.
Prueba con una copia pues no soy un experto. No se si te he entendido
bien. Doy por hecho que en la hoja1 tienes la lista y lo que quieres es
pasar el pedido que te hacen a la hoja2 con el precio de venta y que en la
hoja1 el total lo sacas multiplicando cantidad por costo mediante formula.
Esta Hecho para el rango que expones, pero como supongo que seran
bastantes mas registros, puedes cambiar en donde van los comentarios ('
seguido de texto) los rangos por unos mas amplios, o por una sentencia que
busque la ultima fila con datos.

Espero que te valga.
Un saludo y hasta pronto.


Sub HojaPedido()
Dim Celda As Range, i As Integer
With ActiveWorkbook.Worksheets("Hoja2")
ActiveWorkbook.Worksheets("Hoja1").Range("a1:c3") _
.Copy Destination:=.Range("a1:c3")
.Range("a4:e4") = Array("Pedi", "Cod", "Nombre", "Precio", "Total")
i = 4
Application.ScreenUpdating = False
For Each Celda In ActiveWorkbook.Worksheets("Hoja1") _
.Range("a5:a9") 'puedes poner el rango que te convenga
If Celda <> 0 Then
Range(Celda, Celda.Offset(0, 2)).Copy Destination:= _
.Range(Range("a1").Offset(i, 0).Address, Range("c1") _
.Offset(i, 0).Address)
Celda.Offset(0, 4).Copy Destination:= _
.Range("d1").Offset(i, 0)
.Range("e1").Offset(i, 0) = _
Celda.Offset(0, 4) * Celda
i = i + 1
End If
Celda.Offset(0, 3) = Celda.Offset(0, 3) - Celda
Celda.ClearContents
Next Celda
' pudes cambiar "g50" por la celda que te convenga
.Range("a5", .Range("g50").End(xlDown).Address).Sort (.Range("a5"))
End With
End Sub

hola, chicos !

Ivan escribio en el mensaje ...
... a ver si te vale este codigo... con una copia pues no soy un experto. No se si te he entendido bien [...]

[segun parece]... entendiste perfecto, ademas de que el codigo esta 'genial' [salvo la mejor opinion de KM] :D
[creo que]... solo te hizo falta 'sumar' en la hoja2 el resultado de los articulos 'pasados' [de la hoja1] -?-
si existiera la posibilidad de que en la hoja1 hay 'reglas de validacion' [nombre, direccion, etc.] y/o formatos...
las instrucciones de 'copia directa' [... .Copy Destination:=...] se estarian 'llevando' -tambien- dichas caracteristicas -?-

la siguiente propuesta [creo que] pudiera ser mas 'rapida' al trabajar con autofiltros y pasando 'de golpe' los articulos ;)
[aunque el codigo se ve mas 'aparatoso' y menos 'limpio' que el propuesto] :-(
y el bucle para 'ajustar' la resta de los pedidos trabajaria -solo- con las celdas que se estan 'pasando' [a la hoja2] ;)

es SOLO una forma 'alterna' a tu [mas que] excel...ente propuesta :))

saludos,
hector.

la propuesta +/- igual... pero... diferente :D
Sub HojaPedido_2(): Application.ScreenUpdating = False: Dim Celda As Range
With Worksheets("Hoja1"): If .AutoFilterMode Then .Cells.AutoFilter
With .Range(.[a4], .[a65536].End(xlUp))
.AutoFilter Field:=1, Criteria1:="<>"
.Offset(1).Resize(.Rows.Count - 1).Offset(, 4).Copy
Worksheets("Hoja3").[d5].PasteSpecial xlPasteValues
.Offset(1).Resize(.Rows.Count - 1, 3).Copy
With Worksheets("Hoja3"): .[a5].PasteSpecial xlPasteValues
.[a1:c3].Value = Worksheets("Hoja1").[a1:c3].Value
.[a4:e4] = Array("Pedi", "Cod", "Nombre", "Precio", "Total")
.[e5].Formula = "¥*d5": .Select
With Selection.Offset(, 4): [e5].Copy .Resize(, 1)
.Offset(.Rows.Count).Resize(1, 1).Formula = "=sum(" & .Resize(, 1).Address(0, 0) & ")"
End With: [a1].Select: End With
For Each Celda In .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
Celda.Offset(, 3) = Celda.Offset(, 3) - Celda: Celda.ClearContents: Next
End With: .[a4].AutoFilter: .Select: End With
End Sub

__ codigo de la propuesta 'original' __

Sub HojaPedido()
Dim Celda As Range, i As Integer
With ActiveWorkbook.Worksheets("Hoja2")
ActiveWorkbook.Worksheets("Hoja1").Range("a1:c3") _
.Copy Destination:=.Range("a1:c3")
.Range("a4:e4") = Array("Pedi", "Cod", "Nombre", "Precio", "Total")
i = 4
Application.ScreenUpdating = False
For Each Celda In ActiveWorkbook.Worksheets("Hoja1") _
.Range("a5:a9") 'puedes poner el rango que te convenga
If Celda <> 0 Then
Range(Celda, Celda.Offset(0, 2)).Copy Destination:= _
.Range(Range("a1").Offset(i, 0).Address, Range("c1") _
.Offset(i, 0).Address)
Celda.Offset(0, 4).Copy Destination:= _
.Range("d1").Offset(i, 0)
.Range("e1").Offset(i, 0) = _
Celda.Offset(0, 4) * Celda
i = i + 1
End If
Celda.Offset(0, 3) = Celda.Offset(0, 3) - Celda
Celda.ClearContents
Next Celda
' pudes cambiar "g50" por la celda que te convenga
.Range("a5", .Range("g50").End(xlDown).Address).Sort (.Range("a5"))
End With
End Sub

Hola KM**VE

Ten por seguro que a pesar de las palabras de Hector (hola, y muchas
gracias por tus animos) su codigo, aun sin haberlo probado, funcionara mil
veces mejor que el mio y te recomiendo que sea el que uses. Aun asi y
dandole la razon una vez mas, es cierto que no me acorde de las
totalizaciones de cant y precio. He intentado ¿arreglarlo? en otro codigo
que te paso al final de esta respuesta. En cuanto a la hoja de destino,
supongo que lo que deseas es que si ya existe la hoja del cliente (por
cierto¿en el mismo libro?) cuando coincidan los codigos se añadan las
cantidades a las ya existentes y en caso contrario crear un registro
nuevo. Y si no existe la hoja crearla.Si no fuera asi lo comunicas. Aunque
pienso que estas instrucciones deberian añadirse al codigo de
Hector(probablemente el mismo te lo facilite), yo todavia no tengo nivel
para ello, asi que si puedo te las añadire en el mio y te las mando.

PD: para que veas el nivel de mi ignorancia soy incapaz de abrir en
excel(con un formato util) el archivo que has mandado. Si sabes como
hacerlo te agradeceria si me lo dijeras.

En el codigo da por supuesto que todos los totales del listado los
calculas por formula.

Tambien, y siguiendo otra vez las observaciones de Hector, convendria
canbiar los "copy destination" por (creo) PasteSpecial xlPasteValues o
similar, pero acabo de ver los mensajes y no he tenido tiempo.

Un saludo y hasta pronto
Ivan

Sub HojaPedido3()
Dim Celda As Range, i As Integer
With ActiveWorkbook.Worksheets("Hoja2")

.Range(.Range("a1"), .Range("e65536").End(xlUp)).ClearContents
ActiveWorkbook.Worksheets("Hoja1").Range("a1:c3") _
.Copy Destination:=.Range("a1:c3")
.Range("a4:e4") = Array("Pedi", "Cod", "Nombre", "Precio", "Total")
i = 4
Application.ScreenUpdating = False
For Each Celda In ActiveWorkbook.Worksheets("Hoja1") _
.Range("a5:a9")
If Celda <> 0 Then
Range(Celda, Celda.Offset(0, 2)).Copy Destination:= _
.Range(.Range("a1").Offset(i, 0).Address, .Range("c1") _
.Offset(i, 0).Address)
Celda.Offset(0, 4).Copy Destination:= _
.Range("d1").Offset(i, 0)
.Range("e1").Offset(i, 0) = _
Celda.Offset(0, 4) * Celda
i = i + 1
End If
Celda.Offset(0, 3) = Celda.Offset(0, 3) - Celda
Celda = 0
Next Celda
.Range("a5", .Range("e65536").End(xlUp).Address).Sort (.Range("b5"))
.Range("a1").Offset(.Range("a65536").End(xlUp).Row, 0) = _
Application.Sum(.Range(.Range("a5"),
.Range("a1").Offset(.Range("a65536") _
.End(xlUp).Row - 1, 0)))
.Range("e1").Offset(.Range("e65536").End(xlUp).Row, 0) = _
Application.Sum(.Range(.Range("e5"),
.Range("e1").Offset(.Range("e65536") _
.End(xlUp).Row - 1, 0)))
End With
End Sub

Hola Iván, Gracias por su apoyo de verdad es muy agradecido, tengo algo que
decirte que se me esta borrando el pedido que hago antes en la hoja2 lo que
te pido haber si puede lo siguiente.



1-que sea el nombre de la hoja es lo que uno coloco en la celda (B1) y que
no se borra la hoja cuando es el mismo nombre y si la hoja tiene algún
pedido del mismo nombre es colocar el nuevo pedido debajo el último pedido.



2-si es nuevo nombre y no hay una hoja de el que esta creando que se crea
una nueva hoja para este cliente.



El macro no me funciona por Lina 23 hasta Lina 30 se marco en rojo



Si no hay molestia mandarme un archivo Excel a mi e mail con el macro hecho,
y así para tener tu e mail directo.




Gracias
KM**VE


"Ivan" escribió en el mensaje
news:

Hola KM**VE

Ten por seguro que a pesar de las palabras de Hector (hola, y muchas
gracias por tus animos) su codigo, aun sin haberlo probado, funcionara mil
veces mejor que el mio y te recomiendo que sea el que uses. Aun asi y
dandole la razon una vez mas, es cierto que no me acorde de las
totalizaciones de cant y precio. He intentado ¿arreglarlo? en otro codigo
que te paso al final de esta respuesta. En cuanto a la hoja de destino,
supongo que lo que deseas es que si ya existe la hoja del cliente (por
cierto¿en el mismo libro?) cuando coincidan los codigos se añadan las
cantidades a las ya existentes y en caso contrario crear un registro
nuevo. Y si no existe la hoja crearla.Si no fuera asi lo comunicas. Aunque
pienso que estas instrucciones deberian añadirse al codigo de
Hector(probablemente el mismo te lo facilite), yo todavia no tengo nivel
para ello, asi que si puedo te las añadire en el mio y te las mando.

PD: para que veas el nivel de mi ignorancia soy incapaz de abrir en
excel(con un formato util) el archivo que has mandado. Si sabes como
hacerlo te agradeceria si me lo dijeras.

En el codigo da por supuesto que todos los totales del listado los
calculas por formula.

Tambien, y siguiendo otra vez las observaciones de Hector, convendria
canbiar los "copy destination" por (creo) PasteSpecial xlPasteValues o
similar, pero acabo de ver los mensajes y no he tenido tiempo.

Un saludo y hasta pronto
Ivan

Sub HojaPedido3()
Dim Celda As Range, i As Integer
With ActiveWorkbook.Worksheets("Hoja2")

.Range(.Range("a1"), .Range("e65536").End(xlUp)).ClearContents
ActiveWorkbook.Worksheets("Hoja1").Range("a1:c3") _
.Copy Destination:=.Range("a1:c3")
.Range("a4:e4") = Array("Pedi", "Cod", "Nombre", "Precio", "Total")
i = 4
Application.ScreenUpdating = False
For Each Celda In ActiveWorkbook.Worksheets("Hoja1") _
.Range("a5:a9")
If Celda <> 0 Then
Range(Celda, Celda.Offset(0, 2)).Copy Destination:= _
.Range(.Range("a1").Offset(i, 0).Address, .Range("c1") _
.Offset(i, 0).Address)
Celda.Offset(0, 4).Copy Destination:= _
.Range("d1").Offset(i, 0)
.Range("e1").Offset(i, 0) = _
Celda.Offset(0, 4) * Celda
i = i + 1
End If
Celda.Offset(0, 3) = Celda.Offset(0, 3) - Celda
Celda = 0
Next Celda
.Range("a5", .Range("e65536").End(xlUp).Address).Sort (.Range("b5"))
.Range("a1").Offset(.Range("a65536").End(xlUp).Row, 0) = _
Application.Sum(.Range(.Range("a5"),
Range("a1").Offset(.Range("a65536") _
.End(xlUp).Row - 1, 0)))
Range("e1").Offset(.Range("e65536").End(xlUp).Row, 0) = _
Application.Sum(.Range(.Range("e5"),
Range("e1").Offset(.Range("e65536") _
.End(xlUp).Row - 1, 0)))
End With
End Sub

Hola Hector Miguel, gracias por tus palabras de animo.

De nuevo el codigo que expones abre, para mi, una nueva dimension. Sobre
todo por la sintaxis utilizada, aunque tambien por el uso de autofiltro,
resize y otros. Estos ultimos supongo que mas o menos se pueden comprender
a partir de la ayuda y la intuicion, pero en cuanto a la sintaxis yo de
momento no he encontrado ayuda clara sobre el uso que tu le das. Si no tre
importa y tienes tiempo me gustaria hacerte unas consultas.

1-Sobre el uso de "corchetes": supongo por tu ej. que se usan sustituyendo
a range(¿o a cualquier objeto?) dentro de un grupo With, ¿o lo permite el
uso de autofiltro?

2-Uso de Offset(1) sin separador de argumentos(,): creo intuir que
representa el primer rango del campo por el cual se a filtrado ¿o estoy
equivocado?

3-Uso de with anidados (esto supongo que no sera dificil de hallar). No
estaba seguro de que se pudieran usar. Supongo (parece lo logico) que su
ambito va de dentro a fuera. ¿no tien ningun condicionante?

En cualquier caso muchas gracias.
Un saludo y hasta pronto
Ivan