Como Modificar macro excel vincular casilla

¿Cómo debería modificar el código del macro que originalmente asignaba a las casillas de las columnas de la D a la H vinculo con casilla en las columnas de la I a la M si quiero añadir dos columnas más?

Es decir el vinculo ha de quedar somo sigue:

Casilla D con la K (anteriormente estaba con I)

Casilla E con la L (anteriormente estaba con J)

Y así sucesivamente pero habiendo añadido dos columnas más al grupo de usuarios que tenia originalmente 5 y ahora necesito que sean 7.

El código original era:

Sub CrearCasillas()

'Por.Dante Amor

    Application.ScreenUpdating = False

    ActiveSheet.DrawingObjects.Delete

    '

    For j = Columns("D").Column To Columns("H").Column

        For i = 6 To Range("C" & Rows.Count).End(xlUp).Row

            If Cells(i, "C") <> "" And IsDate(Cells(i, "C")) Then

                dia = Format(Cells(i, "C"), "ddd")

                wsl = Cells(i, j).Left + 25

                wst = Cells(i, j).Top

                wsw = Cells(i, j).Width

                wsh = Cells(i, j).Height

                '

                'c = Cells(3, Columns.Count).End(xlToLeft).Column + 1

                letra = Evaluate("=SUBSTITUTE(ADDRESS(1," & j + 5 & ",4),""1"","""")")

                ActiveSheet.CheckBoxes.Add(wsl, wst, wsw, wsh).Select

                With Selection

                    .Caption = dia

                    .Value = xlOff

                    .LinkedCell = letra & i

                    .Display3DShading = False

                End With

            End If

        Next

    Next

End Sub

1 Respuesta

Respuesta
1

Te anexo la macro actualizada

Sub CrearCasillas()
'Por.Dante Amor
    Application.ScreenUpdating = False
    ActiveSheet.DrawingObjects.Delete
    Range("K:O").ClearContents
    '
    For j = Columns("D").Column To Columns("H").Column
        For i = 6 To Range("C" & Rows.Count).End(xlUp).Row
            If Cells(i, "C") <> "" And IsDate(Cells(i, "C")) Then
                dia = Format(Cells(i, "C"), "ddd")
                wsl = Cells(i, j).Left + 25
                wst = Cells(i, j).Top
                wsw = Cells(i, j).Width
                wsh = Cells(i, j).Height
                '
                letra = Evaluate("=SUBSTITUTE(ADDRESS(1," & j + 7 & ",4),""1"","""")")
                ActiveSheet.CheckBoxes.Add(wsl, wst, wsw, wsh).Select
                With Selection
                    .Caption = dia
                    .Value = xlOff
                    .LinkedCell = letra & i
                    .Display3DShading = False
                End With
            End If
        Next
    Next
    MsgBox "Terminado"
End Sub

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas