Macro copiar información de un Libro a otro y consolidarla
Escribo porque necesito tu ayuda con esta Macro lo que necesito que realice es que copie las 16 hojas de un libro en otro libro, lo que sucede es que algunas veces me funciona común y corriente y otras veces me salen este tipo de errores:
* El encabezado es el mismo que el libro destino
* La variable h fuera del intervalo
* Si abro varios libros de Excel me copia información de otros libros de excel que no debería copiar.
Acá dejo el código te agradezco tu ayuda.
Sub Consolidar()
Dim h As Long
Dim ultima As Integer
Dim Origen As Workbook
Dim HOrigen As Worksheet
Dim Destino As Workbook
Dim HDestino As Worksheet
Dim ruta As String
ruta = ("C:\Users\lina h\Desktop\TRAB\REPORTE_ABOGADOS")
Set Destino = Workbooks(ThisWorkbook.Name)
Set HDestino = Destino.Worksheets("Consolidado")
Call LimpiarTotal
Set Origen = Workbooks.Open(ruta)
For h = 2 To Sheets.Count
Origen.Activate
Sheets(h).Activate
Range("A2").Select
Range(Selection, Cells(2, 15)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Destino.Activate
HDestino.Select
Range("A2").Select
If h > 2 Then
ultima = Cells(Rows.Count, 1).End(xlUp).Row
Cells(ultima, 1).Offset(0, 0).Select
Range("A" & Selection.Row + 1).Select
Else
Range("A2").Select
End If
ActiveSheet.Paste
Next
End Sub
Sub LimpiarTotal()
Sheets(2).Select
Range("A2").Select
Range(Selection, Cells(2, 15)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A2").Select
End Sub
1 Respuesta
Intenta de esta manera, si te marca error me dices en qué línea y cual es el error.
Sub Consolidar()
Dim h As Long
Dim ultima As Integer
Dim Origen, destino As Workbook
Dim HOrigen, HDestino As Worksheet
Dim ruta As String
ruta = ("C:\Users\lina h\Desktop\TRAB\REPORTE_ABOGADOS")
Set destino = ThisWorkbook
Set HDestino = destino.Worksheets("Consolidado")
Call LimpiarTotal
Set Origen = Workbooks.Open(ruta)
Origen.Activate
For h = 2 To Origen.Sheets.Count
Origen.Sheets(h).Activate
Range("A2").Select
Range(Selection, Cells(2, 15)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
destino.Activate
HDestino.Select
Range("A2").Select
If h > 2 Then
ultima = Cells(Rows.Count, 1).End(xlUp).Row
Cells(ultima, 1).Offset(0, 0).Select
Range("A" & Selection.Row + 1).Select
Else
Range("A2").Select
End If
ActiveSheet.Paste
Next
End Sub
Sub LimpiarTotal()
Sheets(2).Select
Range("A2").Select
Range(Selection, Cells(2, 15)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select
End Sub
