Macro que copie nombre de la hoja y lo ponga en otra hoja creada

Agrega las siguientes líneas a tu macro

Pon esta línea al principio de tu macro

n1 = activesheet.name

Después de la línea en donde creas la hoja nueva, supongo que tienes algo así: sheets.add . agrega esta línea:

activesheet.name = "resultados " & n1

Saludos. Dante Amor
No olvides finalizar la pregunta.

Hola! Muchas gracias por la rápida respuesta, te comento que hice lo que me sugieres pero no renombra la hoja :( te anexo la macro con la que estoy trabajando, ojalá puedas ayudarme! :D

Sub copiafila()
For Each sh In ActiveWorkbook.Sheets
'selecciono la hoja
sh.Select
'puedo omitir alguna hoja
If sh.Name <> "Sheet3" Then
Application.ScreenUpdating = False
On Error Resume Next
Dim strnombrehoja$
strnombrehoja$ = ActiveSheet.Name
n1 = ActiveSheet.Name
Set h1 = ActiveSheet
Set h2 = Sheets.Add
ActiveSheet.Name = "resultados " & n1
h1.Select
ini = "A"
fin = "O"
For k = 1 To 4
ActiveWorkbook.Sheets(strnombrehoja$).Range("A" & k).Copy h2.Range("A" & k)
Next
For i = 1 To h1.Range(ini & Rows.Count).End(xlUp).Row
si = 0
For j = 7 To Range(fin & 1).Column
Cells(i, j).Select
If Cells(i, j).Interior.ColorIndex = 6 Or Cells(i, j).Interior.ColorIndex = 27 Then
si = 1
Else
si = 0
End If
Next
If si = 1 Then
Range(ini & i & ":" & fin & i).Select
h1.Range(ini & i & ":" & fin & i).Copy h2.Range(ini & h2.Range(ini & Rows.Count).End(xlUp).Row + 1)
Selection.Delete Shift:=xlUp
i = i - 1
End If
Next
End If
'pasa a la hoja siguiente
Next sh
Application.ScreenUpdating = True
End Sub

Probé tu macro y si renombra, o no entendí lo que necesitas.

Por ejemplo si tu primer hoja se llama "Hoja1", la macro inicia así:

Selecciona la hoja

sh.Select

La variable n1 tiene el nombre de la hoja activa

n1 = activesheet.name

'Se crea la nueva hoja

Set h2 = Sheets.Add

'La hoja activa es la hoja nueva

'Pone el nombre a la hoja nueva

ActiveSheet.Name = "resultados " & n1

'Al final la nueva hoja se llama: "resultados Hoja1"

Eso es lo que hace la macro y funciona bien, ¿es lo que necesitas?

Te lo prometo que lo he probado en repedidas ocasiones y nada :( , mira:

https://www.dropbox.com/s/488j2l1n7l4yz6o/Book1.xlsm

la hoja "sheet6" es la hoja creada a partirde la segunda hoja ("Troquelado Indirecto") la cual como ves no fue renombrada :( (la renombro: sheet6), y la otra hoja ("Inyección Plástica Indirecta") es el ejemplo de hojas donde aplico la macro (como ves, hay filas coloreadas las cuales al aplicar la macro, se debe crear una nueva hoja que copie las filas coloreadas), help me!.

No viene la macro en el archivo ni las hojas que comentas

Oh!! Perdóname! :O gajes del oficio (pena mil) lo he checado y subir el bueno! Aquí está:

https://www.dropbox.com/s/0dqlgz8ymsdjpt7/Libro1.xlsm

Esta ves si probé que fuera el correcto...

El nombre de tu hoja es muy largo, por eso no te lo hace.

Agregué la instrucción left para que recorte el nombre y no tengas problemas.

Sub copiafila()
'For Each sh In ActiveWorkbook.Sheets
    'selecciono la hoja
    ' sh.Select
    'puedo omitir alguna hoja
    'If sh.Name <> "Sheet3" Then
        Application.ScreenUpdating = False
        Set h1 = ActiveSheet
        n1 = Left(h1.Name, 20)
        Set h2 = Sheets.Add
        h2.Name = "resultados " & n1
        h1.Select
        ini = "A"
        fin = "O"
        h1.Rows("1:4").Copy h2.Range("A1")
        For i = 1 To h1.Range(ini & Rows.Count).End(xlUp).Row
            si = 0
            For j = 7 To Range(fin & 1).Column
                'Cells(i, j).Select
                If Cells(i, j).Interior.ColorIndex = 6 Or Cells(i, j).Interior.ColorIndex = 27 Then
                    si = 1
                Else
                    si = 0
                End If
            Next
            If si = 1 Then
                Range(ini & i & ":" & fin & i).Select
                h1.Range(ini & i & ":" & fin & i).Copy h2.Range(ini & h2.Range(ini & Rows.Count).End(xlUp).Row + 1)
                Selection.Delete Shift:=xlUp
                i = i - 1
            End If
        Next
    'End If
    'pasa a la hoja siguiente
'Next sh
Application.ScreenUpdating = True
End Sub

Corregí esta instrucción para que te copie los 4 filas de h1 a h2.

H1.Rows("1:4"). Copy h2. Range("A1")

Lo que sigue ya no lo revisé, eso ya no lo modifiqué.