Como buscar la primer fila vacía de una base de datos y darle un valor correspondiente de permiso:
Para Dante Amor:
Me gustaría saber si me podrías ayudar con esto, tengo un código con el cual busco el primer valor vacío de una base de datos que se encuentra en una hoja llamada TC la cual se activa cuando le doy click a una lista de texto en otra hoja que se llama LOTO. Este es mi código:
If Target.Address = Cells(4, 11).Address Then
If Cells(4, 11).Value = "SI" Then
Worksheets("TC").Select
If Worksheets("TC").Cells(4, 2) <> "" Then
Worksheets("TC").Cells(3, 2).Select
Worksheets("TC").[B3].End(xlDown).Offset(1, -1).Select
Worksheets("TC").[B3].End(xlDown).Offset(1, 0).Value = Worksheets("LOTO").Cells(4, 1).Value
Worksheets("LOTO").Cells(4, 12).Value = ActiveCell.Value
Sheets("LOTO").Select
End If
If Worksheets("TC").Cells(4, 2) = "" Then
Worksheets("TC").Cells(4, 1).Select
ActiveCell.Offset(0, 1).Value = Worksheets("LOTO").Cells(4, 1).Value
Worksheets("LOTO").Cells(4, 12).Value = ActiveCell.Value
End If
End If
End If
If Target.Address = Cells(4, 11).Address Then
If Cells(4, 11).Value = "NO" And Cells(4, 12) <> "" Then
Dim a As Object
dato = Worksheets("LOTO").Cells(4, 12).Value
Set a = Worksheets("TC").Range("A4: A10000").Find(dato, LookIn:=xlValues, Lookat:=xlWhole)
Sheets("TC").Activate
Worksheets("TC").Cells(a.Row, a.Column + 1).Select
Worksheets("TC").Cells(a.Row, a.Column + 1).ClearContents
Worksheets("LOTO").Cells(4, 12).ClearContents
End If
Sheets("LOTO").Select
End If
El problema que tiene es que el Sub ya no me permite ingresar más datos porque lo estaba haciendo para cada celda, entonces busco la forma de adaptar este código para n número de columnas.
2 Respuestas
H o l a : Puedes enviarme tu archivo y me explicas el funcionamiento, es decir, cuál hoja selecciono, cuál celda selecciono, qué dato pongo en la celda, y qué es lo que debería hacer la macro.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Adrián Silva” y el título de esta pregunta.
Avísame en esta pregunta cuando me lo hayas enviado.
S a l u d o s . D a n t e A m o r
Te anexo las macros para actualizar todas las hojas
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Or Target.Row < 4 Then Exit Sub
cols = Array("K", "M", "O", "Q", "S", "U", "W", "Y", "AA")
hojas = Array("TC", "EC", "BL", "IE", "RG", "IZ", "AT", "TA", "AE")
For j = LBound(cols) To UBound(cols)
If Not Intersect(Target, Columns(cols(j))) Is Nothing Then
Call Actualizar(hojas(j), Target)
End If
Next
End Sub
'
Sub Actualizar(hoja, Target)
'Por.Dante Amor
Application.EnableEvents = False
Set h = Sheets(hoja)
If Target.Value = "SI" Then
fila = 4
Do While h.Cells(fila, "B") <> ""
fila = fila + 1
Loop
h.Cells(fila, "B") = Cells(Target.Row, "A")
Target.Offset(0, 1) = h.Cells(fila, "A")
ElseIf Target.Value = "NO" And Target.Offset(0, 1).Value <> "" Then
Set b = h.Columns("A").Find(Target.Offset(0, 1).Value, lookat:=xlWhole)
If Not b Is Nothing Then h.Cells(b.Row, "B").ClearContents
Target.Offset(0, 1).ClearContents
End If
Application.EnableEvents = True
End Sub'S aludos. Dante Amor.