Macro para Ordenar
Quisiera saber como puedo diseñar una macro que me permita ordenar datos de la siguiente manera:
En una hoja tengo un campo en el que el usuario adiciona nuevos datos, estos datos deben ir a otra hoja en donde hay una base de datos general que permite hacer consultas desde diversas hojas del archivo, la macro debe evitar que se repitan códigos ya introducidos y debe dejar la base de datos ordenada por el código (supongamos que la información que se ingresa es Código-Nombre-Peso-Altura y el código siempre debe ser un número) para futuras consultas.
En una hoja tengo un campo en el que el usuario adiciona nuevos datos, estos datos deben ir a otra hoja en donde hay una base de datos general que permite hacer consultas desde diversas hojas del archivo, la macro debe evitar que se repitan códigos ya introducidos y debe dejar la base de datos ordenada por el código (supongamos que la información que se ingresa es Código-Nombre-Peso-Altura y el código siempre debe ser un número) para futuras consultas.
1 Respuesta
Respuesta de Elsa Matilde
1
Creo que esta macro con algunos pequeños ajustes te servirá. Se coloca en la hoja donde haces la carga
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Donde As String
Dim filalibre As Integer
Dim Que As String
Dim Quepaso As Object
If Target.Address(False, False) = "A4" Then
'la variable Donde guarda el rango donde debe efectuarse la búsqueda
filalibre = Sheets("Hoja3").Range("A3").End(xlDown).Row
Donde = "A2:A" & filalibre
'la variable Que guarda el dato a buscar que se encuentra en la celda E1
Que = Target.Value
Set Quepaso = Sheets("Hoja3").Range(Donde).Find(Que, LookIn:=xlValues, LookAt:=xlWhole)
If Quepaso Is Nothing Then
'si no se encuentra el dato guarda el valor
Sheets("Hoja3").Cells(filalibre, 1).Value = Target.Value
'guardar otros datos
'
filalibre = filalibre + 1
'ORDENAR
Sheets("Hoja3").Range("A2:B" & filalibre).Sort Key1:=Sheets("Hoja3").Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom
Else
'si encontró el dato envia mensaje
MsgBox "Ya existe código"
End If
End If
End Sub
Saludos
Elsa
*** No te pierdas el Manual con las 200+ Macros explicadas en español. Descarga la Demo gratis desde:
http://es.geocities.com/lacibelesdepunilla/manual
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Donde As String
Dim filalibre As Integer
Dim Que As String
Dim Quepaso As Object
If Target.Address(False, False) = "A4" Then
'la variable Donde guarda el rango donde debe efectuarse la búsqueda
filalibre = Sheets("Hoja3").Range("A3").End(xlDown).Row
Donde = "A2:A" & filalibre
'la variable Que guarda el dato a buscar que se encuentra en la celda E1
Que = Target.Value
Set Quepaso = Sheets("Hoja3").Range(Donde).Find(Que, LookIn:=xlValues, LookAt:=xlWhole)
If Quepaso Is Nothing Then
'si no se encuentra el dato guarda el valor
Sheets("Hoja3").Cells(filalibre, 1).Value = Target.Value
'guardar otros datos
'
filalibre = filalibre + 1
'ORDENAR
Sheets("Hoja3").Range("A2:B" & filalibre).Sort Key1:=Sheets("Hoja3").Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom
Else
'si encontró el dato envia mensaje
MsgBox "Ya existe código"
End If
End If
End Sub
Saludos
Elsa
*** No te pierdas el Manual con las 200+ Macros explicadas en español. Descarga la Demo gratis desde:
http://es.geocities.com/lacibelesdepunilla/manual
