Saltar al contenido

Macro para guardar hoja en otro libro


Recommended Posts

Buenos días a los integrantes de este prestigioso foro, esta ocasión recurro a uds para que me ayuden con una macro o quizás mejorarla, la idea que tengo es extraer toda la información (conservando su formato) de la pestaña CONSOLIDADO y que se guarde automáticamente en la carpeta donde se está trabajando, el nombre del archivo que se extrae esta en hoja PLANILLA celda D2, fecha y hora y con la extensión “.xlsx” (CONSOLIDADO CYPRESS ARROW2 2-5-2019 18-20-56 HRS.xlsx), como se aprecia en la macro que describe a continuación.

Adjunto link de archivo.

https://drive.google.com/file/d/1_SVxDlLOyuGGmpIih5d-M4wYJSm6S7La/view?usp=sharing

Modulo 5:

Sub GuardarComo30072015()

Dim ncorr As String
With Application
.ScreenUpdating = False

NOMBRE = ThisWorkbook.Name
carpeta = ThisWorkbook.Path
filaa = carpeta & "\" & NOMBRE

ncorr = Format(Hoja1.Range("D2").Value, "000")

A = " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " " & Hour(Time) & "-" & Minute(Time) & "-" & Second(Time) & " HRS"

.DisplayAlerts = False
.EnableEvents = False
If nombrar = vbYes Then
    filab = carpeta & "\" & "plantilla electronica1"
    ActiveWorkbook.SaveAs Filename:=filab, FileFormat:=xlOpenXMLWorkbookMacroEnabled

Else
        filab = carpeta & "\" & "CONSOLIDADO " & ncorr & UCase(titulo) & A
        Call Elimina_hojas
        ActiveWorkbook.SaveAs Filename:=filab, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        ActiveWorkbook.Close
End If
.EnableEvents = True
.DisplayAlerts = True

xnombre = ActiveWorkbook.Name
Workbooks.Open filaa
vuf = Range("B" & Rows.Count).End(xlUp).Row
Range("B8:AQ" & vuf).ClearContents
Workbooks(xnombre).Close

.ScreenUpdating = True
End With

End Sub

Sub Elimina_hojas()
Dim Vec, Elim, ws As Worksheet
'
Vec = Array("PLANILLA", "RESUMEN", "BOLETA", "CONSOLIDADO", "DATA", "EXPORTA", "REPORTE BOLETAS", "TELECREDITO JUDICIAL", "TELECREDITO", "DESCUENTO", "MENU", "SORT", "NAVI", "RECIBO", "TABLA AFP") ' Estas son las hojas que se mantienen.
'
ReDim Elim(0 To 0)
For Each ws In Worksheets
  If IsError(Application.Match(ws.Name, Vec, 0)) Then
    ReDim Preserve Elim(1 To 1 + UBound(Elim)): Elim(UBound(Elim)) = ws.Name
  End If
Next

Application.DisplayAlerts = False: On Error Resume Next
  Worksheets(Elim).Delete
On Error GoTo 0: Application.DisplayAlerts = True
MsgBox "Finalizando....."
Sheets("MENU").Activate
Range("B8").Select
End Sub

Desde ya agradezco su apoyo y colaboración.

Enlace a comentario
Compartir con otras webs

En 8/6/2019 at 17:14 , SALAVERRINO dijo:

Desde ya agradezco su apoyo y colaboración.

O no he entendido lo que necesitas, o para lo que pides te sobra todo ese código :huh:. Lo que yo he entendido es esto:
 

Sub copiar_consolidado()
Dim nom$, fech$, hor$, fich$

Application.ScreenUpdating = False

nom = Sheets("PLANILLA").Cells(2, "d")
fech = Format(Date, "dd-mm-yy")
hor = Format(Time, "hh-mm-ss")

fich = ThisWorkbook.Path & "\" & nom & "_" & fech & "_" & hor & " HRS" & ".xlsx"

Sheets("CONSOLIDADO").Copy
ActiveWorkbook.SaveAs (fich)
ActiveWorkbook.Close

End Sub

 

Enlace a comentario
Compartir con otras webs

Archivado

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

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

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


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      177
    • Comentarios
      90
    • Revisiones
      27

  • Crear macros Excel

  • Mensajes

    • No va a ser necesario distinguir el tipo de proceso entre 1 y 2. Revisa el adjunto a ver si es eso lo que quieres. Function MediaAttention(mImp As Range, _ q25 As Range, q50 As Range, _ Optional q75 As Range, _ Optional q100 As Range) As Double '-- Opción 1 If q75 Is Nothing And q100 Is Nothing Then MediaAttention = q25 / q50 Exit Function End If '-- Opción 2 MediaAttention = ((0.25 * (q25 - q50)) / mImp) + _ ((0.5 * (q50 - q75)) / mImp) + _ ((0.75 * (q75 - q100)) / mImp) + _ (q100 / mImp) End Function   Media Attention Formula 1.2.xlsb
    • Gracias tomarse el tiempo de leer por responder Maestro @Antoni Adjunto el archivo con la idea a la que deseo llegar, sigo atento. Mil gracias por el tiempo y la ayuda brindada   Media Attention Formula 1.2.xlsb
    • He analizado la UDF y entiendo perfectamente lo que hace, lo que no entiendo es lo que pretendes hacer. Mejor sube un ejemplo resuelto de  como debería funcionar la UDF con los nuevos parámetros solicitados. 
    • Gracias, ya lo conseguí solucionar
    • Hola a todos Primero que nada deseo agradecer el tiempo en leer este post, Muchas Gracias. Me acerco a ustedes para pedir su ayuda para lo siguiente: Tengo una UDF, la cual tiene dos escenarios: 1.- Si Tiempo Promedio y Duración del Video son diferentes de 0, hacer el calculo 2.- Si lo anterior es igual a 0, se realiza el otro calculo por cuartiles. El detalle es que son muchas celdas a seleccionar, lo cual creo puede ser engorroso, entonces, pensando en simplificar la función, me pregunte si fuera posible: a.- Colocar 1 al principio de la función y después solo seleccionar 2 celdas correspondientes (Rango continuo o discontinuo) b.- Colocar 2 al principio de la función y después seleccionar las 5 celdas correspondientes (Rango continuo o discontinuo) Espero me puedan ayudar y/o orientar al respecto, quedo atento para cualquier duda, de antemano les agradezco cualquier ayuda brindada. Mil Gracias!! Media Attention Formula 1.1.xlsb  
  • 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.