Macro para unir varios excel en uno solo
Publicado por Pablo (2 intervenciones) el 28/02/2017 14:29:48
Buenos días,
La siguiente macro une varios excel en uno solo, el problema es que me gustaría que la primera fila de cada excel (cabecera) solo la copiase una única vez al principio del fichero¿Que parte del código debo modificar?. Gracias de antemano.
Un saludo.
La siguiente macro une varios excel en uno solo, el problema es que me gustaría que la primera fila de cada excel (cabecera) solo la copiase una única vez al principio del fichero¿Que parte del código debo modificar?. Gracias de antemano.
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
Sub Abrir_Archivos()
Dim Hoja As Object
Application.ScreenUpdating = False
'Definir la variable como tipo Variante
Dim X As Variant
'Abrir cuadro de dialogo
X = Application.GetOpenFilename _
("Excel Files (*.xlsx), *.xlsx", 2, "Abrir archivos", , True)
'Validar si se seleccionaron archivos
If IsArray(X) Then ' Si se seleccionan
'Crea Libro nuevo
Set newBook = Workbooks.Add
'Captura nombre de archivo destino donde se grabaran los archivos seleccionados
A = ActiveWorkbook.Name
For y = LBound(X) To UBound(X)
Application.StatusBar = "Importando Archivos: " & X(y)
Workbooks.Open X(y)
b = ActiveWorkbook.Name
For Each Hoja In ActiveWorkbook.SheetsHoja.Copy after:=Workbooks(A).Sheets(Workbooks(A).Sheets.Count)
Next
Workbooks(b).Close False
Next
Application.StatusBar = "Listo"
Call Unir_Hojas
End If
Application.ScreenUpdating = False
End Sub
Sub Unir_Hojas()
Dim Sig As Byte, eliminar As BooleanFor Sig = 2 To Worksheets.Count
Worksheets(Sig).UsedRange.Copy _
Worksheets(1).Range("a1000000").End(xlUp).Offset(1)
Next
Application.DisplayAlerts = False
For Sig = 2 To Worksheets.Count
Worksheets(2).Delete
Next
Application.DisplayAlerts = True
End Sub
Un saludo.
Valora esta pregunta
0