Error en macro, repite hojas al hacer un bucle
Tengo el siguiente Macro que se activa cada vez que activo la Hoja Precios
Intento que liste todas las hojas con el nombre VELA_algo, que serian los productos (para que no me liste todas las hojas del libro que tienen otra información)
Que las ordene por alfabeto, que mantenga las fórmulas que genera esa lista en las columnas siguientes y que agregue o elimine productos de la lista (bucle) si se crean o eliminan,.
Funcionaba perfecto hasta que lo empecé a probar y me va repitiendo la ultima fila (ultimo producto) hasta que toda la lista es ESE producto. No entiendo que pasa
Private Sub Worksheet_Activate()
If ActiveSheet.Name = "Precios" Then
Incorporar_Hipervínculos
End If
End Sub
Sub Incorporar_Hipervínculos()
ActiveSheet.Unprotect
Dim w As Worksheet, sHoja As String
For Each w In ThisWorkbook.Worksheets
' Verificar si el nombre de la hoja contiene la palabra "VELA"
If InStr(1, w.Name, "VELA", vbTextCompare) > 0 Then
' Verificar si la hoja existe antes de realizar operaciones en ella
On Error Resume Next
Dim testSheet As Worksheet
Set testSheet = ThisWorkbook.Worksheets(w.Name)
On Error GoTo 0
If Not testSheet Is Nothing Then ' La hoja existe
Dim fill As Long
fill = 2 ' Reiniciar la variable fill en cada iteración
sHoja = w.Name
Cells(fill, 2).FormulaR1C1 = sHoja
ActiveSheet.Hyperlinks.Add Anchor:=Cells(fill, 2), Address:="", _
SubAddress:=sHoja & "!A1", TextToDisplay:=sHoja
fill = fill + 1
End If
End If
Next w
Columns("B:j").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
3 Respuestas
Tu macro genera los hipervínculos a partir de la fila 2, por cada nombre de hoja.
Cuando tenés más nombres que hojas (alguna pudo haber sido eliminada) ... te sigue quedando el registro.
Te dejo la macro ajustada.
Sub Incorporar_Hipervínculos()
ActiveSheet.Unprotect
Dim w As Worksheet, sHoja As String
Dim fill As Long
fill = 2 ' fila inicio en Precios. Reiniciar la variable fill en cada iteración
finx = Range("B" & Rows.Count).End(xlUp).Row 'fila final
For Each w In ThisWorkbook.Worksheets
' Verificar si el nombre de la hoja contiene la palabra "VELA"
If InStr(1, w.Name, "VELA", vbTextCompare) > 0 Then
' Verificar si la hoja existe antes de realizar operaciones en ella
On Error Resume Next
Dim testSheet As Worksheet
Set testSheet = ThisWorkbook.Worksheets(w.Name)
On Error GoTo 0
If Not testSheet Is Nothing Then ' La hoja existe
sHoja = w.Name
Cells(fill, 2).FormulaR1C1 = sHoja
ActiveSheet.Hyperlinks.Add Anchor:=Cells(fill, 2), Address:="", _
SubAddress:=sHoja & "!A1", TextToDisplay:=sHoja
fill = fill + 1
End If
End If
Next w
'controlar si quedan fila sin hoja relacionada. Eliminarlas.
If fill <= finx Then
For i = fill To finx
Range("B" & i).EntireRow.Delete
Next i
End If
Columns("B:j").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Revisa si lo siguiente es lo que necesitas:
Sub Incorporar_Hipervínculos()
Dim w As Worksheet
Dim fill As Long
ActiveSheet.Unprotect
fill = 2
For Each w In ThisWorkbook.Worksheets
If InStr(1, w.Name, "VELA", vbTextCompare) > 0 Then
Cells(fill, 2).FormulaR1C1 = w.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(fill, 2), Address:="", _
SubAddress:="'" & w.Name & "'!A1", TextToDisplay:=w.Name
fill = fill + 1
End If
Next w
Columns("B:j").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End SubRecomendaciones:
Curso de macros. Consejos para empezar a programar. - YouTube
Curso de macros. Declarar variables en vba excel. - YouTube
Excel vba dictionary parte 1 - YouTube|
Sal u dos
Dante Amor
Perfecto!!!!
ahora, por que me repite el ultimo ?? esto me va a volver loca...
A lo mejor ese valor ese valor ya existe.
Debes limpiar la hoja, o al menos esa columna, antes de ejecutar la macro, o pon esta línea en la macro para que limpie esa columna:
Sub Incorporar_Hipervínculos()
Dim w As Worksheet
Dim fill As Long
ActiveSheet.Unprotect
fill = 2
Range("B2:B" & Rows.Count).ClearContents
For Each w In ThisWorkbook.Worksheets
If InStr(1, w.Name, "VELA", vbTextCompare) > 0 Then
Cells(fill, 2).FormulaR1C1 = w.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(fill, 2), Address:="", _
SubAddress:="'" & w.Name & "'!A1", TextToDisplay:=w.Name
fill = fill + 1
End If
Next w
Columns("B:j").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End SubNuevo:
sal u dos
Dante Amor
El problema que estás experimentando puede estar relacionado con la variable fill en tu código. Actualmente, estás reiniciando la variable fill a 2 en cada iteración del bucle, lo que hace que la última fila se repita en todas las hojas. Para solucionar esto, mueve la inicialización de la variable fill antes del bucle For Each de la siguiente manera:
Sub Incorporar_Hipervínculos()
ActiveSheet.Unprotect
Dim w As Worksheet, sHoja As String
Dim fill As Long ' Mueve la inicialización de la variable fill aquí
fill = 2 ' Inicializa la variable fill fuera del bucle
For Each w In ThisWorkbook.Worksheets
' Verificar si el nombre de la hoja contiene la palabra "VELA"
If InStr(1, w.Name, "VELA", vbTextCompare) > 0 Then
' Verificar si la hoja existe antes de realizar operaciones en ella
On Error Resume Next
Dim testSheet As Worksheet
Set testSheet = ThisWorkbook.Worksheets(w.Name)
On Error GoTo 0
If Not testSheet Is Nothing Then ' La hoja existe
sHoja = w.Name
Cells(fill, 2).FormulaR1C1 = sHoja
ActiveSheet.Hyperlinks.Add Anchor:=Cells(fill, 2), Address:="", _
SubAddress:=sHoja & "!A1", TextToDisplay:=sHoja
fill = fill + 1
End If
End If
Next w
Columns("B:j").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End SubAl mover la inicialización de fill fuera del bucle For Each, aseguras que la variable se reinicie solo una vez antes de comenzar el bucle. De esta manera, se incrementará correctamente en cada iteración y evitarás la repetición de la última fila en todas las hojas.