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.
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
