............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

Terminar macro en una celda concreta

Ver el tema anterior Ver el tema siguiente Ir abajo

Terminar macro en una celda concreta

Mensaje por JuanjoYO el Lun Oct 05, 2015 4:34 pm

Hola amigos, veréis, tengo un problema y es que tengo una base de datos en Hoja2 que voy rellenando desde Hoja1 con un formulario de tres registros en excel (no he empleado vba). y que inserto con una macro que he realizado grabada en un botón Aceptar
Dicha B.D. puede llegar a tener hasta 500 registros.
De momento estoy haciendo pruebas y solo tengo unos 20 registros
Cuando despues de insertar los registros con el botón aceptar voy a la Hoja2 (B.D.), me encuentro con que me la abre en la fila 409 con lo cual veo toda la pantalla en blanco
Es una aplicación que van a utilizar unas 100 personas y no puedo explicarles que si quieren ver la B.D. tras insertar los registros se van a encontrar una hoja en blanco, aunque ir al principio sea tan sencillo como pulsar ctrl+inicio.
Qué debería añadir a la macro para que al ir a la hoja2 me la situara por ejemplo en la celda A1 ?
He probado con la instrucción Range("A1").Select (lo único hecho desde vba) al final de la macro, pero nada, que no funciona
Copio la macro que tengo
Muchas gracias por vuestra ayuda

Sub TODOS()
'
' TODOS Macro
'

'

Application.ScreenUpdating = False
Sheets("Hoja2").Select
ActiveSheet.Unprotect
Range("E1:E500").Select
Range("E1:E500").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"AA1:AA50"), Unique:=True
Range("F1:F500").Select
Range("F1:F500").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"AG1:AG50"), Unique:=True
Range("AF2:AF50").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-21
Range("AB2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AA2:AB50").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Add Key:=Range("AB2:AB50") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hoja2").Sort
.SetRange Range("AA1:AB50")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AI2:AI50").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-18
Range("AH2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AI1").Select
Application.CutCopyMode = False
Range("AG2:AH50").Select
ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Add Key:=Range("AH2:AH50") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
Range("A1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

JuanjoYO

Masculino Cantidad de envíos : 3
Edad : 60
Ciudad - Pais : Huesca
Version de Excel : 2007
Fecha de inscripción : 25/01/2013

Volver arriba Ir abajo

Re: Terminar macro en una celda concreta

Mensaje por rolano el Vie Oct 23, 2015 4:27 pm

Código:

Sub TODOS()
'
' TODOS Macro
'

'

Application.ScreenUpdating = False
Sheets("Hoja2").Select
ActiveSheet.Unprotect
Range("E1:E500").Select
Range("E1:E500").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"AA1:AA50"), Unique:=True
Range("F1:F500").Select
Range("F1:F500").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"AG1:AG50"), Unique:=True
Range("AF2:AF50").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-21
Range("AB2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AA2:AB50").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Add Key:=Range("AB2:AB50") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hoja2").Sort
.SetRange Range("AA1:AB50")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AI2:AI50").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-18
Range("AH2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AI1").Select
Application.CutCopyMode = False
Range("AG2:AH50").Select
ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Add Key:=Range("AH2:AH50") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'nombre de la hoja
Sheets("Hoja2").Select
Range("A1").Select

End Sub

_________________
Saludos,
César Tirado
M.A.P. 2012-2014
Microsoft Active Professional
Blog
avatar
rolano
Moderador
Moderador

Masculino Cantidad de envíos : 53
Edad : 43
Fecha de inscripción : 14/04/2009

http://excelilove.blogspot.com/

Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.