6024

domingo, 26 de abril de 2020

Macro Unir Archivos de Excel





CÓDIGO PARA COPIAR: 


Sub UnirFiles() Dim Hoja As Object Application.DisplayAlerts = False A = ActiveWorkbook.Name R = ActiveWorkbook.Path ChDir R & "\" archi = Dir("*.xls*") Do While archi <> A Workbooks.Open archi B = ActiveWorkbook.Name For Each Hoja In ActiveWorkbook.Sheets Hoja.Copy After:=Workbooks(A).Sheets(Workbooks(A).Sheets.Count) Next Workbooks(B).Close False archi = Dir() Loop End Sub

1 comentario: