Últimos mensajes - Powered by IBM

Palabras claves

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

23/03/2006 - 23:38 por klomkbock | Informe spam

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

Siga el debate

7 respuestas

Tengo una respuesta

Preguntas similare

Leer las respuestas

#1 KM**VE

24/03/2006 - 00:35 | Informe spam

Hola Iván, garcías por tu atención y tu apoyo de mejorar un macro tan
generoso y es útil para cual Quero persona y creo que hay mucha gente que le
hace falta este tipo de macro para manejas un pequeño deposito y unas
cuentas pequeñas, me imagino que usted estas imaginando para que uso tengo
este tipo de hoja de Excel, y mientras que usted pone la idea mejor y
mejorar los uso de este tipo de macro es mas útil para todo.

Nota: haber si sub. Total y el Total que se hace para cada pedido que sea de
bajo de cada pedido y así separamos un poco mejor cada pedido y darle una
forma a los Totales de millones 0.00.000 a todo que tengan precio y totales,
es mi idea haber que opina.

Gracias por tu apoyo

KM**VE

"Ivan" escribió en el mensaje
news:

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

Responder a este mensaje

#2 klomkbock

24/03/2006 - 02:47 | Informe spam

Hola KM ¿Kalhed?

Te ruego disculpes mis parrafadas, pues supongo que no debes entender la
mayoria. En cualquier caso, y con tiempo, intentare adaptar el codigo a lo
que quieres. Pero te aseguro que no miento al decir que no soy ningun
experto, mas bien estoy aprendiendo segun escribo la macro. Quizas seria
mejor, si te corre prisa y quieres asgurarte el resultado, que volvieras a
mandar una consulta al foro con lo que falta, pues yo no estoy seguro de
conseguirlo.

De momento y por lo menos para distinguir con facilidad un pedido de otro
puedes insertar la instruccion que te pongo a continuacion que pone en un
color el fondo de la primera fila de cada pedido.

Despues de esta istruccion:
.BorderAround Weight:=xlThick
.Offset(0, 5).Font.Bold = True
Range(.Offset(0, -5), .Offset(0, 1)).Interior.ColorIndex = 8
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

KM**VE wrote:

Hola Iván, garcías por tu atención y tu apoyo de mejorar un macro tan
generoso y es útil para cual Quero persona y creo que hay mucha gente que le
hace falta este tipo de macro para manejas un pequeño deposito y unas
cuentas pequeñas, me imagino que usted estas imaginando para que uso tengo
este tipo de hoja de Excel, y mientras que usted pone la idea mejor y
mejorar los uso de este tipo de macro es mas útil para todo.

Nota: haber si sub. Total y el Total que se hace para cada pedido que sea de
bajo de cada pedido y así separamos un poco mejor cada pedido y darle una
forma a los Totales de millones 0.00.000 a todo que tengan precio y totales,
es mi idea haber que opina.

Gracias por tu apoyo

KM**VE

"Ivan" escribió en el mensaje
news:
> 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
>
>
>

Responder a este mensaje

#3 klomkbock

24/03/2006 - 03:01 | Informe spam

Disculpame, no se que pasa que debo tocar alguna tecla y se envia el
mensaje sin querer.

Como te decia:

Despues de estas istrucciones:
.BorderAround Weight:=xlThick
.Offset(0, 5).Font.Bold = True

Escribe lo siguiente:

Range(.Offset(0, -5), .Offset(0, 1)).Interior.ColorIndex = 8

Estas son las instrucciones que van detras(NO hay que tocarlas)

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

Con esto por lo menos tendras una referencia visual del comienzo de cada
pedido. Puedes cambiar el color por uno que te guste mas(cambiando el nº 8
en ColorIndex = 8). En cualquier caso, si antes no te lo soluciona
alguien, intentare mandarte lo que te hace falta, pero posiblemente tarde
un poco.

Un saludo y hasta pronto.
Ivan

Responder a este mensaje

#4 klomkbock

25/03/2006 - 19:11 | Informe spam

Hola KM

Creo que este nuevo codigo te puede valer. No esta muy probado, asi que
puede que aparezca algun error.

La hoja de inicio (listado) sigue siendo igual que las ultimas, pero en la
de cliente ahora te aparece el subtotal debajo de cada pedido y el total
al final del todo. El ultimo pedido aparece abajo.

Espero que te sirva.

Un saludo y hasta pronto.
Ivan

Sub GuardarPedidoCasiCasiOk4() ' Con metodo subtotal
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
With Worksheets(Cliente): .[a1].PasteSpecial xlPasteValues
.[a5:g5] = Array _
("Pedi", "Cod", "Nombre", "Precio", "Total", "NºPedi", "Fecha")
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
.Range(.[a1], .[b3]).Borders(xlInsideHorizontal).LineStyle = xlDouble
.Range(.[b1], .[b3]).Font.Bold = True
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
.Range(.[a5], .[g65536].End(xlUp)).Subtotal GroupBy:=6, _
Function:=xlSum, TotalList:=Array(1, 5)
For Each Celda2 In Range(.[f6], .[f65536].End(xlUp))
If Celda2 = "Total " & Celda2.Offset(-1, 0) Then
Celda2.Offset(0, -5).Interior.ColorIndex = 44
Celda2.Offset(0, -1).Interior.ColorIndex = 44
ElseIf Celda2 = "Total general" Then
Celda2.Offset(0, -5).Interior.ColorIndex = 8
Celda2.Offset(0, -1).Interior.ColorIndex = 8
End If: 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

KM**VE wrote:

Hola Iván, garcías por tu atención y tu apoyo de mejorar un macro tan
generoso y es útil para cual Quero persona y creo que hay mucha gente que le
hace falta este tipo de macro para manejas un pequeño deposito y unas
cuentas pequeñas, me imagino que usted estas imaginando para que uso tengo
este tipo de hoja de Excel, y mientras que usted pone la idea mejor y
mejorar los uso de este tipo de macro es mas útil para todo.

Nota: haber si sub. Total y el Total que se hace para cada pedido que sea de
bajo de cada pedido y así separamos un poco mejor cada pedido y darle una
forma a los Totales de millones 0.00.000 a todo que tengan precio y totales,
es mi idea haber que opina.

Gracias por tu apoyo

KM**VE

"Ivan" escribió en el mensaje
news:
> 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
>
>
>

Responder a este mensaje

#5 klomkbock

26/03/2006 - 03:10 | Informe spam

Hola KM

Soy un poco pesado pero a cada momento veo cosas nuevas.

El codigo de antes es un poco lento cuando trabaja con muchos registros.
Al final del post te lo mando retocado y bastante mas rapido. Tambien te
da formato a los subtotales, pero no numericos, solo pone bordes, negrita
y colorea los totales. Para el formato numerico (millones, etc..) de
momento no consigo resultados que me gusten. Si te hace falta puedes
seleccionar cada columna que te interese formatear y usar >>boton derecho

formato de celda, >>numero, >>numero, >>y marcar separador de miles y/o

nº de decimales. Solo tendras que hacerlo una vez por hoja(creo). Sigue
con cuidado al probarlo.

Un saludo y hasta pronto.
Ivan

Sub GuardarPedidoCasiCasiOk6()
' Con metodo subtotal
' Mas rapido
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
With Worksheets(Cliente): .[a1].PasteSpecial xlPasteValues
.[a5:g5] = Array _
("Pedi", "Cod", "Nombre", "Precio", "Total", "NºPedi", "Fecha")
End With: End If
Range(.[a6], .[g65536].End(xlUp)).Sort (.[a6]), Header:=xlYes
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
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
.Range(.[a1], .[b3]).Borders(xlInsideHorizontal).LineStyle = xlDouble
.Range(.[b1], .[b3]).Font.Bold = True
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
.Range(.[a5], .[g65536].End(xlUp)).Subtotal GroupBy:=6, _
Function:=xlSum, TotalList:=Array(1, 5)
For Each Celda2 In Range(.[f6], .[f65536].End(xlUp))
With Celda2
If .Value = "Total " & .Offset(-1, 0) Then
With .Offset(0, -5)
.Font.Bold = True
.BorderAround Weight:=xlMedium
.Interior.ColorIndex = 44
End With
With .Offset(0, -4)
.Value = "Piezas Ped.Nº:" & Celda2.Offset(-1, 0)
.Font.Bold = True
.BorderAround Weight:=xlThin
End With
With .Offset(0, -1)
.Font.Bold = True
.BorderAround Weight:=xlMedium
.Interior.ColorIndex = 44
End With
.Value = "Total Ped.Nº:" & .Offset(-1, 0)
.BorderAround Weight:=xlThin
ElseIf Celda2 = "Total general" Then
With .Offset(0, -5)
.Font.Bold = True
.BorderAround Weight:=xlMedium
.Interior.ColorIndex = 8
End With
With .Offset(0, -4)
.BorderAround Weight:=xlMedium
.Font.Bold = True
.Value = "Total piezas"
End With
With .Offset(0, -1)
.Font.Bold = True
.BorderAround Weight:=xlMedium
.Interior.ColorIndex = 8
End With
.BorderAround Weight:=xlThin
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

Responder a este mensaje

Ads by Google

Hacer una preguntaSiguiente

Tengo una respuesta

Busqueda sugerida