Macro para unificar 3 hojas de un libro de excel en un nuevo archivo con un botón
Dante un gusto de saludarte, vengo a pedirte tu apoyo nuevamente, me has estado apoyando con las macros para que a través de un botón unifique tres hojas en un solo archivo nuevo.
La macro que te voy a colgar es la que me apoyaste y crea el nuevo archivo con las tres hojas, pero solo en la hoja de análisis de débitos traslada tal y como esta cuando cuando se solicita crear el nuevo archivo (como hay otra macro que oculta y muestra filas) y en las hojas de análisis de créditos y junta directiva imprimir crea los archivos pero no realiza la macro que tiene para ocultar y mostrar filas, ya que cuando crea las hojas en el nuevo archivo las traslada completas.
Sub Crear_xls()
Dim wb As Workbook
Dim h2 As Worksheet
Dim i As Long, h As Long
Dim hojas As Variant, cols1 As Variant, cols2 As Variant, cols3 As Variant
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
hojas = Array("Análisis de Créditos", "Análisis de Débitos", "Junta Directiva (Imprimir)")
cols1 = Array("J", "E", "C")
cols2 = Array("J", "E", "D")
cols3 = Array("L", "H", "E")
'
Sheets(hojas(0)).Copy
Set wb = ActiveWorkbook
For h = 1 To UBound(hojas)
ThisWorkbook.Sheets(hojas(h)).Copy after:=wb.Sheets(wb.Sheets.Count)
Next
For h = 0 To UBound(hojas)
Set h2 = wb.Sheets(hojas(h))
h2.Unprotect ("regional2018")
h2.Cells.EntireRow.Hidden = False
h2.UsedRange.Value = h2.UsedRange.Value
Next
For h = 0 To UBound(hojas)
h2.Range(cols3(h) & 1, h2.Cells(1, Columns.Count)).EntireColumn.Delete
'
For i = h2.Range(cols1(h) & Rows.Count).End(3).Row To 7 Step -1
If h2.Range(cols1(h) & i) = 0 And h2.Range(cols2(h) & i) = 0 Then
h2.Range(cols1(h) & i).EntireRow.Delete
End If
Next i
Next
wb.SaveAs ThisWorkbook.Path & "\" & "3 hojas" & ".xlsx", xlOpenXMLWorkbook
wb.Close False
'
Application.ScreenUpdating = True
MsgBox "Hojas. Guardadas en un nuevo archivo"
End Suby en los nuevos archivos no funcionan los sutotales, te adjunto imagen
Respuesta de Dante Amor
1
