Macro duplicar y renombrar hoja excel

Necesito una macro que me copie la hoja activa al final del libro y renombre la hoja nueva con un numero consecutivo a esta ultima incrementado en 1, manteniendo el texto inicial de la original.

Pej. Jesus 001 pedro 002 jesus 003. Si entro en jesus 001 y ejecuto la macro me copia la hoja al final y mantiene el nombre pero la numera en incremento de 1 con respecto a la ultima sin tener en cuenta el nombre (me creara jesus 003). Si entro en pedro 002 y ejecuto la macro me genera pedro 004 a continuación de jesus 003.

Y ya para rizar el rizo si se puede quiero que el dato numérico del nombre de la nueva hoja creada 001, 002, etc me lo copie en una celda de la nueva hoja Pej A1.

1

1 respuesta

Respuesta
1

H o l a:

Puedes revisar tu ejemplo.

Si tienes las hojas:

Jesus 001 pedro 002 jesus 003

Y ejecutas la macro dentro de Jesus, ¿entonces te debería crear Jesus 004?

Entonces, si ahora tienes estas hojas:

Jesus 001 pedro 002 jesus 003 jesus 004, y entras en pedro 002 y ejecutas la macro, ¿te debería crear pedro 005?

E spero tus comentarios.

Eso es exactamente lo que pretendo

Y la hoja nueva que quede activa, es decir, la que quede abierta

Y la hoja nueva que quede activa, es decir, la que quede abierta

H o l a:

Te anexo la macro

Sub CrearHoja()
'Por.Dante Amor
    hactiva = ActiveSheet.Name
    hnombre = Left(hactiva, Len(hactiva) - 4)
    For i = Sheets.Count To 1 Step -1
        nhoja = Right(Sheets(i).Name, 3)
        If IsNumeric(nhoja) Then
            nuevahoja = Format(Val(nhoja) + 1, "000")
            Exit For
        End If
    Next
    '
    If nuevahoja <> "" Then
        nombre = hnombre & " " & nuevahoja
        Sheets(hactiva).Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = nombre
    End If
End Sub

Funciona perfectamente, sólo falta que el dato numérico del nombre de la nueva hoja "000" se copie en una celda de dicha hoja Pej. A1

H o l a, te anexo la macro actualizada:

Sub CrearHoja()
'Por.Dante Amor
    hactiva = ActiveSheet.Name
    hnombre = Left(hactiva, Len(hactiva) - 4)
    For i = Sheets.Count To 1 Step -1
        nhoja = Right(Sheets(i).Name, 3)
        If IsNumeric(nhoja) Then
            nuevahoja = Format(Val(nhoja) + 1, "000")
            Exit For
        End If
    Next
    '
    If nuevahoja <> "" Then
        nombre = hnombre & " " & nuevahoja
        Sheets(hactiva).Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = nombre
        ActiveSheet.[A1] = "'" & nuevahoja
    End If
End Sub

s aludos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas