Macro para copiar hoja a nuevo libro

Te anexo la macro con lo siguiente:

1. Te copia la hoja activa en un nuevo libro

2. Copia valores (sin fórmulas)

3. El nuevo libro contiene una sola hoja

4. Te lo guarda con el nombre de la celda C5

5. Te da la opción de seleccionar la carpeta donde lo quieres guardar.

Sub copiahoja()
'Por.dam
    On Error Resume Next
    ActiveSheet.Copy
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Set navegador = CreateObject("shell.application")
    carpeta = navegador.browseforfolder(0, _
    "SELECCIONE UNA CARPETA PARA COPIAR EL ARCHIVO", 0, "C:\").items.Item.Path
    If carpeta <> "" Then
        If Right(carpeta, 1) <> "\" Then
            carpeta = carpeta & "\"
        End If
        If Range("C5") <> "" Then
            arch = Range("C5")
        Else
            arch = "archivo"
        End If
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=carpeta & arch & ".xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    End If
End Sub

Prueba y me comentas

Saludos. Dam

Muchas gracias Dam.

Excelente trabajo y respuesta. Puede aclararme, si es posible que a la hora de copiar:

- no copiara los macros ni botones de macros y

- Pensando un poco y para hacerlo aun más sencillo para quien lo van a usar, podría guardarse directamente en el escritorio en vez de tener que elegir carpeta.

Muchas gracias