Macro para guardar hoja en otro libro
Publicado por JOSE LUIS (60 intervenciones) el 09/06/2019 15:48:20
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
Modulo 5:
Desde ya agradezco su apoyo y colaboración
Adjunto link de archivo.
https://drive.google.com/file/d/1_SVxDlLOyuGGmpIih5d-M4wYJSm6S7La/view
Modulo 5:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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
Valora esta pregunta
0