Agregar formato a código

15/10/2007 - 15:06 por GRIEGO59 | Informe spam
Hola!
Tengo el siguiente código que funciona en la hoja “menú”:

' en un modulo normal -
'
Sub Copiar()
Dim ultF As Long
If [e34] = "" Then _
MsgBox "El nombre es obligatorio": _
[e34].Select: Reponer: Exit Sub
With Worksheets("préstamos")
ultF = .[a65536].End(xlUp).Row + 1
.Cells(ultF, 1) = [e34]
.Cells(ultF, 2) = [e35]
.Cells(ultF, 4) = [e36]
.Cells(ultF, 6) = [e37]
.Cells(ultF, 8) = [e38]
.Cells(ultF, 10) = [e39]
.Cells(ultF, 11) = [e40]
.[a1].CurrentRegion.Sort key1:=.[a2], _
order1:=xlAscending, header:=xlYes
End With
Range("e34,e36,e37,e39,e40").ClearContents
[e34].Select
Reponer
End Sub
Sub Reponer()
Application.OnKey "{enter}"
Application.OnKey "{return}"
End Sub

Funciona bien, pero me gustaría que:
Copie y pegue manteniendo el formato de destino sobre todo las fechas.
Que al final cuando ordena las filas, lo haga en función, primero de la
columna “a” y luego en función de la columna “b”.


Notas:
La hoja de destino, donde debe pegar tiene la función Menú, datos, lista,
crear lista.
Antes funcionaba al presionar “enter” estando posicionado en una celda
determinada, pero ahora funciona al presionar un botón.
Algunas veces, inexplicablemente copia y pega debajo de la lista.

Gracias por la ayuda
Griego59

Preguntas similare

Leer las respuestas

#1 Héctor Miguel
16/10/2007 - 05:00 | Informe spam
hola, Darío !

__ 1 __
Mostrar la cita
__ 2 __
Mostrar la cita
__ 3 __
Mostrar la cita
1) aunque la propiedad ".Value" es la propiedad "por omision" de un objeto "Range" (por lo que no es indispensable indicarla)...
algunas veces conviene hacerlo de manera explicita (entre otros, porque te agrega el formato numerico del valor que se copia)
o sea, agrega -> .Value despues de cada celda copiada (p.e.) de -> .Cells(ultF, 1) = [e34] a -> .Cells(ultF, 1) = [e34].Value

2) puedes agregar un segundo criterio de ordenacion en la instruccion donde usas el metodo .Sort (+/- como sigue):
.[a1].CurrentRegion.Sort _
Key1:=.[a2], Order1:=xlAscending, _
Key2:=.[b2], Order2:=xlAscending, Header:=xlYes

3) (presumiblemente) cuando te sucede que los datos sean copiados "despues" de la lista (auto-expandible) creada...
se debera a que la celda "activa" (en ese momento en la hoja "prestamos") esta dentro de tu listado -?-
con lo cual, la ultima celda esta (provisionalmente) "ocupada" por un asterisco, o por la palabra "totales", o... ???
-> puedes "corregir/prevenir/evitar/..." esa posibilidad, si cambias de buscar la ultima fila "basada" en la columna A por la B
de: -> ultF = .[a65536].End(xlUp).Row + 1
a: -> ultF = .[b65536].End(xlUp).Row + 1

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

__ el codigo expuesto __
Mostrar la cita
#2 GRIEGO59
16/10/2007 - 13:31 | Informe spam
Hola, Hector!
Gracias por ayudarme!

"Héctor Miguel" escribió:
Mostrar la cita
Me equivoqué con lo del formato de destino. El código pega los datos en la
última fila de la lista y no había notado que la última fila de la lista
tiene formato general. Aunque yo asigné formotos a cada columna completa, la
lista pone formato general en la última fila. Por lo que con el .value, las
fechas se muestran en formato dd/mm/aaa como deseo, pero los números se
muestran sin el punto de los miles y la alineación horizontal de las celdas
copiadas, se pierde. : (

Mostrar la cita
Esta parte funcionó bien. : )


Mostrar la cita
Si tienes razón, como siempre, en lugar de "B" usé "C" porque "B" a veces
está vacía. : )


Mostrar la cita
#3 Héctor Miguel
17/10/2007 - 02:16 | Informe spam
hola, Darío !

Mostrar la cita
Por lo que con el .value, las fechas se muestran en formato dd/mm/aaa como deseo
Mostrar la cita
el unico detalle es que estas copiando celdas contiguas en un rango [E34:E40] desde la hoja "activa"...
para pegarlas sobre celdas NO contiguas (siguiente fila libre de la hoja "prestmos" columnas 1, 2, 4, 6, 8, 10 y 11)

si los formatos los tienen las celdas del rango 'E34:E40' de la hoja activa... prueba con las siguientes modificaciones al codigo
si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Sub Copiar()
If [e34] = "" Then _
MsgBox "El nombre es obligatorio": [e34].Select: Exit Sub
Dim ultF As Long, ColDest, Sig As Byte
ColDest = Array(1, 2, 4, 6, 8, 10, 11)
With Worksheets("prestamos")
ultF = .[c65536].End(xlUp).Row + 1
For Sig = LBound(ColDest) To UBound(ColDest)
[e34].Offset(Sig).Copy .Cells(ultF, ColDest(Sig))
Next
Application.CutCopyMode = False
.[a1].CurrentRegion.Sort _
Key1:=.[a2], Order1:=xlAscending, _
Key2:=.[b2], Order2:=xlAscending, Header:=xlYes
End With
Range("e34,e36,e37,e39,e40").ClearContents
[e34].Select
End Sub
#4 GRIEGO59
19/10/2007 - 12:29 | Informe spam
Gracias! : )
Funciona excelente!

"Héctor Miguel" escribió:

Mostrar la cita
Ads by Google
Search Busqueda sugerida