Copiar tabla de una hoja y pegar en un libro nuevo

[jmprioja]

Hola, tengo un pequeño contratiempo y necesito hacer una macro que me haga lo siguiente, a ver si alguien me puede ayudar:

Estando en un libro Excel ejecuto una macro que me copia una tabla en otro libro nuevo creado automáticamente. El nombre del libro que me crea automáticamente es libro1, libro2, depende las veces que ejecute la macro, el que genera por sí solo, pero si detecta que ya existe y quiero cancelar me sale un error(13).

La cuestión es que quiero que ese libro nuevo se cree con la fecha y hora actual y así no tendré problemas con el nombre del libro. Tengo hecho la siguiente macro:

Sub copiaTabla()

'

'Declaramos las variables.

Dim NombreHoja As String

Dim Confirmacion As String

Dim NombreArchivo As String

'Dim GuardarComo As Variant

'

'

'Copiamos la hoja y guardamos.

NombreHoja = ActiveSheet.Name

Confirmacion = MsgBox("Desea guardar la hoja '" & NombreHoja & "' como archivo nuevo?", _

vbQuestion + vbYesNo, "EXCELeINFO")

If Confirmacion = vbYes Then

Application.ScreenUpdating = False

Desproteger_hoja 'macro que me desprotege la hoja

Range("Tabla2836[#All]").Select

Selection.Copy

Workbooks.Add 'Agrega libro nuevo ¿Cómo pongo para ponerle el nombre de fecha y hora actuales?

ActiveSheet.Paste

Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Application.DisplayFormulaBar = True 'Barra de fórmula

ActiveWindow.DisplayHeadings = True 'Reglas

Range("A2").Select

NombreArchivo = ActiveWorkbook.Name 'Lee el nombre del libro activo y lo guarda en la variable

'Guardamos y cerramos el libro creado

ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'Guarda el libro creado

ActiveWorkbook.Close 'Cierra el libro creado

'Nos vamos al libro de trabajo

Application.Goto ActiveWorkbook.Sheets(NombreHoja).Cells(11, 1)

ActiveCell.Select

Proteger_hoja 'macro que vuelve a proteger la hoja

Application.ScreenUpdating = True

MsgBox "El libro se ha guardado con el nombre " & NombreArchivo, vbInformation + vbOKOnly

End If

End Sub

[Antoni]

Sería algo parecido a esto

ActiveWorkbook.SaveAs  _

   FileName:=ThisWorkbook.Path & "\" & Format(Now, "yyyymmddhhmmss ") & NombreArchivo, _

   FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

[/CODE]

[jmprioja]

Hola de nuevo Marco Antonio

Me funciona pero se me para en "ActiveSheet.Paste"

A continuación te pongo lo que he hecho:

Sub copiaHoja()

'

'Declaramos las variables.

Dim NombreHoja As String

Dim Confirmacion As String

Dim NombreArchivo As String

'Copiamos la hoja y guardamos.

NombreHoja = ActiveSheet.Name

Confirmacion = MsgBox("Desea guardar la hoja '" & NombreHoja & "' como archivo nuevo?", _

vbQuestion + vbYesNo, "EXCELeINFO")

If Confirmacion = vbYes Then

Application.ScreenUpdating = False

Range("Tabla28[#All]").Select 'Seleccionamos rango

Selection.Copy 'Copia selección

Workbooks.Add 'Inserta un libro nuevo

'Guarda el libro con el nombre fecha y hora actuales OK Fuciona

ActiveWorkbook.SaveAs _

Filename:=ThisWorkbook.Path & "\" & Format(Now, "ddmmyyyy hhmmss") & NombreArchivo, _

FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

'A PARTIR DE AQUÍ NO ME FUNCIONA

ActiveSheet.Paste 'Pega los datos copiados

Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Application.DisplayFormulaBar = True 'Barra de fórmula

ActiveWindow.DisplayHeadings = True 'Reglas

Range("A2").Select

NombreArchivo = ActiveWorkbook.Name 'Lee el nombre del libro activo y lo guarda en la variable

'Guardamos y cerramos el libro creado

ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'ActiveWorkbook.SaveAs Filename:=NombreHoja, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

ActiveWorkbook.Close 'Cerrar el libro creado

'Nos vamos al libro de trabajo

Application.Goto ActiveWorkbook.Sheets(NombreHoja).Cells(11, 1)

ActiveCell.Select

Application.ScreenUpdating = True

MsgBox "El libro se ha guardado con el nombre " & NombreArchivo, vbInformation + vbOKOnly

End If

End Sub

[Antoni]

Sube el archivo para poder probarlo.

[jmprioja]

Esta macro la he agregado a un programa que estoy terminando y tiene 5,65 MB, no puedo subirlo. Pero te enseño lo que he hecho y ahora me funciona, puedes compararlo.

¿Convendría poner algún control de errores o no hace falta, qué opinas?

ASÍ SÍ ME FUNCIONA

Sub copiaHoja()

'Declaramos las variables.

Dim NombreHoja As String

Dim Confirmacion As String

Dim NombreArchivo As String

NombreHoja = ActiveSheet.Name

Confirmacion = MsgBox("Desea guardar la hoja '" & NombreHoja & "' como archivo nuevo?", _

vbQuestion + vbYesNo, "EXCELeINFO")

If Confirmacion = vbYes Then

Application.ScreenUpdating = False

Desproteger_hoja 'macro para desproteger la hoja

Range("Tabla28[#All]").Select 'Seleccionamos rango

Selection.Copy 'Copia selección

Workbooks.Add 'Inserta un libro nuevo

'Pega los datos copiados

ActiveSheet.Paste

Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Application.DisplayFormulaBar = True 'Barra de fórmula

ActiveWindow.DisplayHeadings = True 'Reglas

Range("A2").Select

'Guarda el libro creado con el nombre fecha y hora actualizado

ActiveWorkbook.SaveAs _

Filename:=ThisWorkbook.Path & "\" & "Copia " & Format(Now, "ddmmyyyy hhmmss"), _

FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

'Lee el nombre del libro activo y lo guarda en la variable (fecha y hora)

NombreArchivo = ActiveWorkbook.Name

'Cerramos el nuevo libro que está activo

ActiveWorkbook.Close

'Nos vamos al libro de trabajo

Application.Goto ActiveWorkbook.Sheets(NombreHoja).Cells(11, 1)

ActiveCell.Select

Proteger_hoja 'macro para proteger la hoja

Application.ScreenUpdating = True

MsgBox "El libro se ha guardado con el nombre " & NombreArchivo, vbInformation + vbOKOnly

End If

End Sub

[Antoni]

.

Hay un viejo dicho informático que dice:

Si funciona, no lo toques

.

[jmprioja]

Estoy muy agradecido por tu ayuda.

Muchas gracias. Un saludo.

[Armando Montes]

SOLUCIONADO