Modificar Macro cuando los nombres de las hojas son variables.
Dam, por favor, de la siguiente macro creada por usted, que hay que cambiar o modificar para que los nombres de los nuevos libros sigan siendo los nombres de las hojas pero necesito que se tenga en cuenta NO nombres constantes, sino nombres variables, pues en ese u tro libro puede llevar un número de hojas y nombres diferentes a los planteados..
Sub copiar2()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
wp = ThisWorkbook.Path & "\"
ars = Array("", "Ingresos", "Egresos", "Inventarios", "Proveedores", "Clientes")
For i = 1 To 5
Workbooks.Open ThisWorkbook.Path & "\" & "Consolidado" ' Línea modificada
ActiveWorkbook.SaveAs Filename:=wp & ars(i), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
For Each h In Sheets
If h.Name <> ars(i) Then h.Delete
Next
ActiveWorkbook.Sabe
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Nuevamente y de antemano Infinitas gracias por la ayuda prestada.
Saludos.
1 respuesta
Dam, muchas gracias por tu respuesta, veo que no me entiendes, lo que solicito de tu ayuda es que hay que modificar para que ese código en la parte de negrilla, o sea el nombre de las 5 hojas no sea siempre una constante sino que el número y nombre de hojas sean variables, lo de abrir el archivo con extensión ya lo solucioné, con la modificación que le hice ya abre y crea los libros perfectamente. Pero la cantidad y nombre deben ser variables.
Esta sería la macro
Sub copiar2()
'Por.DAM
Dim hs As New Collection
Application.ScreenUpdating = False
Application.DisplayAlerts = False
wp = ThisWorkbook.Path & "\"
Workbooks.Open ThisWorkbook.Path & "\" & "Consolidado"
For Each h In Sheets
hs.Add h.Name
Next
ActiveWorkbook.Close
For i = 1 To hs.Count
Workbooks.Open ThisWorkbook.Path & "\" & "Consolidado" ' Línea modificada
ActiveWorkbook.SaveAs Filename:=wp & hs(i), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
For Each h In Sheets
If h.Name <> hs(i) Then h.Delete
Next
ActiveWorkbook.Save
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Saludos. DAM
Si es lo que necesitas.
