Rango dinámico de celdas para una macro
Todo Expertos! Tengo una macro en donde el rango de unas celdas se encuentra fijo sin embargo quisiera que ese rango este dado si encuentra texto en la celda contigua a la derecha, el valor fijo esta dado por C2:C8 pero este rango va creciendo por eso si en D9 hay texto no quiero ampliar en forma manual el rango de C2:C9 sino que la macro lo haga solo.
Mi macro
Sub macro()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim celda As Range
Application.ScreenUpdating = False
Set sh1 = Sheets("Valores")
Set sh2 = Sheets("Resultados")
sh1.Select
Set celda = ActiveCell
If celda.Address(0, 0) = "C2" Or Intersect(celda, sh1.Range("C2:C8")) Is Nothing Then
Set celda = sh1.Range("C8")
Else
Set celda = celda.Offset(-1)
End If
celda.Select
sh2.Select
Range("B1").Value = celda.Value
Application.ScreenUpdating = True
End Sub
Respuesta de Dante Amor
2
Prueba:
Sub macro()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim celda As Range
dim lr as long
Application.ScreenUpdating = False
Set sh1 = Sheets("Valores")
Set sh2 = Sheets("Resultados")
sh1.Select
Set celda = ActiveCell
lr = range("D" & rows.count).end(3).row
if lr < 2 then lr = 2
If celda.Address(0, 0) = "C2" Or Intersect(celda, sh1.Range("C2:C" & lr)) Is Nothing Then
Set celda = sh1.Range("C" & lr)
Else
Set celda = celda.Offset(-1)
End If
celda.Select
sh2.Select
Range("B1").Value = celda.Value
Application.ScreenUpdating = True
End SubRecomendaciones:
Formato condicional al seleccionar fecha. Excel - YouTube
Abrir archivo y copiar hoja. Macros de excel. - YouTube
Sal u dos Dante Amor
1 respuesta más de otro experto
Respuesta de Rafael Vera
2
Aquí tienes el código actualizado
Sub macro()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim celda As Range, lastRow As Range
Application.ScreenUpdating = False
Set sh1 = Sheets("Valores")
Set sh2 = Sheets("Resultados")
sh1.Select
Set celda = ActiveCell
Set lastRow = sh1.Columns("D").Find("*", sh1.Cells(1, "D"), xlValues, , xlByColumns, xlPrevious)
If lastRow Is Nothing Then
Set celda = sh1.Range("C8")
Else
Set celda = sh1.Range("C2:C" & lastRow.Row)
End If
celda.Select
sh2.Select
Range("B1").Value = celda.Value
Application.ScreenUpdating = True
End Sub