Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Copiar tabla de una hoja y pegar en un libro nuevo

jmprioja

Recommended Posts

jmprioja Novato

jmprioja

publicado
publicado

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 Veterano

Antoni

publicado
publicado

Sería algo parecido a esto



ActiveWorkbook.SaveAs  _

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

   FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

[/CODE]

jmprioja Novato

jmprioja

publicado
  • Autor
publicado

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

jmprioja Novato

jmprioja

publicado
  • Autor
publicado

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

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Current Donation Goals

    • Mantenimiento de la comunidad
      Raised 0.00 EUR of 130.00 EUR target

  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      29
    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Un juego del Rabino en Excel
    Por pegones1

    2    1

  • Crear macros Excel

  • Mensajes

    • Tilin2023
      FORMULA MACRO PARA QUE LA FORMULA SIEMPRE TOME LA ULTIMA FILA Y COLUMNA DE UNA TABLA A PESAR QUE AUMENTE

      Por Tilin2023 · publicado

      Adjunto excel CONTADOR FINAL.xlsb
    • Tilin2023
      FORMULA MACRO PARA QUE LA FORMULA SIEMPRE TOME LA ULTIMA FILA Y COLUMNA DE UNA TABLA A PESAR QUE AUMENTE

      Por Tilin2023 · publicado

      Buenos días,  espero se encuentren bien de salud compañeros, Favor me podrían ayuda con lo siguientes como se podría hacer cuando tengo una tabla dinámica que  amedida que se aumente las columnas fechas con data un formula que se coloco al final busque o analice siempre la ultima fila y columna de la fecha. Coloco un ejemplo
    • Tilin2023
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por Tilin2023 · publicado

      @JSDJSD Excelentes, GRACIAS POR TU SOPORTE , me ayudo demasiado es exactamente lo que quería. 5 ESTRELLAS
    • JSDJSD
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por JSDJSD · publicado

      'Opción 1 Sub FiltrarSKUPorFecha(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim diccionarioSKU As Object Dim listaEliminar As Object Dim fechaActual As String, fechaSiguiente As String Dim f As Variant With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Crear diccionarios para comparar SKU y almacenar filas a eliminar Set diccionarioSKU = CreateObject("Scripting.Dictionary") Set listaEliminar = CreateObject("Scripting.Dictionary") ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then diccionarioSKU.RemoveAll ' Limpiar el diccionario antes de llenarlo ' Guardar los SKU de la fecha siguiente (solo de la siguiente) For f = fila + 1 To ultimaFila If .Cells(f, 1).Value <> fechaSiguiente Then Exit For diccionarioSKU(.Cells(f, 2).Value) = 1 Next f ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Solo eliminar si el SKU no está en la fecha siguiente If Not diccionarioSKU.exists(.Cells(f, 2).Value) Then listaEliminar(f) = 1 ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar.keys .Rows(f).Delete Next End With MsgBox "Completado correctamente.", vbInformation End Sub 'Opción 2 Sub FiltrarSKUPorFecha1(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim listaEliminar As Collection Dim fechaActual As String, fechaSiguiente As String Dim f As Variant, i As Long Dim SKUExiste As Boolean With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Inicializar la colección para marcar las filas a eliminar Set listaEliminar = New Collection ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Comprobar si el SKU está en la fecha siguiente SKUExiste = False For i = fila + 1 To ultimaFila If .Cells(i, 1).Value <> fechaSiguiente Then Exit For If .Cells(i, 2).Value = .Cells(f, 2).Value Then SKUExiste = True Exit For End If Next i ' Si el SKU no se encuentra en la fecha siguiente, marcar para eliminar If Not SKUExiste Then listaEliminar.Add f ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar .Rows(f).Delete Next f End With MsgBox "Completado correctamente.", vbInformation End Sub   TABLA ELIMINAR.xlsm
    • JSDJSD
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por JSDJSD · publicado

      Prueba y comenta 

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.