paraKM**VE: Re: copiar de una hoja y pegarlo en otra con macro

Hola KM*VE

En realidad el texto que te adjunto lo habia mandado a la cadena de post
en la hoja nosecuantos del foro, pero he vuelto a cambiar el codigo porque
seguia(y seguramente seguira) habiendo unos cuantos gazapos. Con este,
aparte, me he permitido poner bordes y algunos rangos en negrita para
hacer mas legible la hoja cliente.



Aquí te mando otro código que creo que resuelve la mayoría de los errores
del anterior y realiza lo último que comentas. La hoja del listado sigue
siendo como la ultima que te comente pero en la hoja del cliente pasa a
reflejar (al ejecutar la macro) los totales de venta y de piezas en las
celdas E1 y E2, y los totales de cada pedido en las celdas a la derecha de
la primera fila de cada pedido. El nombre del cliente y el nº de pedido es
obligatorio introducirlos (en la hoja Listado).

Espero que este te sea más útil, aunque probablemente sea muy mejorable en
su estructura. Como siempre, ve con cuidado.

Si puedes me confirmas que lo has visto y si te ha sido útil.

Por otro lado, lo que te comentaba el otro dia es que yo lo que hago
(intento) en un caso parecido al tuyo (pero con proveedores en vez de
clientes) es un libro por cliente, guardados en la misma carpeta. En la
primera hoja estarian los datos del cliente, en la segunda un listado de
todos los pedidos (un registro por pedido) con los totales y todos los
datos/campos que quiera reflejar de cada pedido, y las restantes serian
una hoja para cada pedido con el detalle( tambien podrias poner una con el
detalle por articulos).

Tambien intentaria introducir el pedido mediante un formulario o una hoja
que hiciera las funciones del mismo y que podria ir en el libro del
listado, aunque si trabajas con pocos articulos quizas no te haga falta.

En cualquier caso es cuestion de las necesidades de cada uno y de la forma
de trabajar o las preferencias.

Con las dudas hablamos.
Un saludo y hasta pronto
Ivan

Este es el nuevo codigo(un poco largo y farragoso):

Sub GuardarPedidoCasiCasiOk2()
Dim Cliente As String, i As Long
Dim Celda As Range, Celda2 As Range
Dim Total As Long, Piezas As Long
Application.ScreenUpdating = False
With Worksheets("Hoja1"): Cliente = .[b1]
If .[b1] = "" Then
MsgBox ("Falta el nombre del cliente.")
.Activate: .[b1].Select: Exit Sub
ElseIf .[e1] = "" Then
MsgBox ("Falta el numero del pedido.")
.Activate: .[e1].Select: Exit Sub
End If
On Error Resume Next
If IsError(ActiveWorkbook.Sheets(Cliente)) Then
Worksheets.Add After:=Worksheets("Hoja1")
ActiveSheet.Name = Cliente
.[a1:c3].Copy ': Application.CutCopyMode = False
With Worksheets(Cliente): .[a1].PasteSpecial xlPasteValues
.[a5:g5] = Array _
("Pedi", "Cod", "Nombre", "Precio", "Total", "NºPedi", "Fecha")
.[d1] = "PIEZAS": .[d2] = "TOTAL $"
: End With: End If
With .[a65536].End(xlUp)
If .Row = 5 Then
MsgBox ("No has introducido la cantidad pedida.")
.Activate: .Offset(1, 0).Select: Exit Sub
ElseIf .Row > 5 And Not IsNumeric(.Value) Then
MsgBox ("El dato introducido no es valido, revisalo.")
.Activate: .Select: Exit Sub
Else
Range(Range("a6"), .Range).Sort (.[a6])
End If: End With
For Each Celda In .Range(.[a6], .[a65536].End(xlUp))
.Range(Celda, Celda.Offset(, 2)).Copy
With Worksheets(Cliente): i = .[a65536].End(xlUp).Row
.Range(.[a1].Offset(i, 0), .[c1] _
.Offset(i, 0)).PasteSpecial xlPasteValues
Celda.Offset(0, 4).Copy
.[d1].Offset(i, 0).PasteSpecial xlPasteValues
.[e1].Offset(i, 0) = Celda.Offset(0, 4) * Celda
.[f1].Offset(i, 0) = Worksheets("Hoja1").[e1]
.[g1].Offset(i, 0) = Worksheets("Hoja1").[e2]
.[g1].Offset(i, 0) = FormatDateTime(.[g1].Offset(i, 0))
Celda.Offset(0, 3) = Celda.Offset(0, 3) - Celda
Celda.ClearContents: i = i + 1: End With: Next Celda
With Worksheets(Cliente)
.Range(.[a6], .[g65536].End(xlUp).Address) _
.Sort Key1:=.[f6], Order1:=xlDescending, _
Key2:=.[b6], Order2:=xlAscending
.[e1] = Application.Sum(.Range(.[a6], _
.[a1].Offset(.[a65536].End(xlUp).Row - 1, 0)))
.[e2] = Application.Sum(.Range(.[e6], _
.[e1].Offset(.[e65536].End(xlUp).Row - 1, 0)))
.Range(.[h6], .[k1].Offset(.[f65536].End(xlUp).Row, 0)).Delete
.Range(.[a1], .[b3]).Borders(xlInsideHorizontal).LineStyle = xlDouble
.Range(.[b1], .[b3]).Font.Bold = True
With .Range(.[e1], .[e2])
.Font.Bold = True
.BorderAround Weight:=xlMedium
.Borders(xlInsideHorizontal).Weight = xlMedium
End With
With .Range(.[a5], .[g5])
.Font.Bold = True
.BorderAround Weight:=xlMedium
.Borders(xlInsideVertical).Weight = xlMedium
End With
With .Range(.[a6], .[g65536].End(xlUp))
.BorderAround Weight:=xlMedium
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlInsideVertical).Weight = xlThin
End With
For Each Celda2 In .Range(.[f6], .[f65536].End(xlUp))
With Celda2: Total = .Offset(0, -1).Value
Piezas = .Offset(0, -5).Value
If .Value <> .Offset(-1, 0) Then
.Offset(0, 2) = "TT PedNº" & .Value & "="
.Offset(0, 3) = Total
.Offset(0, 4) = "Pzs PedNº" & .Value & "="
.Offset(0, 5) = Piezas
Range(.Offset(0, 2), .Offset(0, 3)) _
.BorderAround Weight:=xlThick
.Offset(0, 3).Font.Bold = True
Range(.Offset(0, 4), .Offset(0, 5)) _
.BorderAround Weight:=xlThick
.Offset(0, 5).Font.Bold = True
ElseIf .Value = .Offset(-1, 0) Then
.Offset(0, 3).End(xlUp) = .Offset(0, 3).End(xlUp) + Total
.Offset(0, 5).End(xlUp) = .Offset(0, 5).End(xlUp) + Piezas
End If: End With: Next Celda2: .Columns.AutoFit
End With
.Range(.[a6], .[e65536].End(xlUp).Address).Sort (.[b6])
.Range(.[b1], .[b3]).ClearContents
.Range(.[e1], .[e2]).ClearContents
End With
End Sub