Saltar al contenido

Leer varios archivos de excel y concentrar en una sola hoja


DiegoLG

Recommended Posts

publicado

Hola a todos amigos, tengo este código que me trae la información de un libro, sin embargo, ando intentando importar varios archivos a la vez pero ya me bloquié, este es el código que ocupo para leer el libro, espero alguien me puede dar una idea, saludos

Application.ScreenUpdating = False
Dim wbLibroOrigen As Workbook
Dim wsHojaOrigen As Worksheet

Dim wbLibroDestino As Workbook
Dim wsHojaDestino As Worksheet

Dim ruta As String

ruta = ActiveWorkbook.Path & "\" & "Lista_Negra_SAT.csv"
'Datos destino
Set wbLibroDestino = Workbooks(ThisWorkbook.Name)
Set wsHojaDestino = wbLibroDestino.Worksheets("Hoja1")

'Datos origen
Set wbLibroOrigen = Workbooks.Open(ruta)
Set wsHojaOrigen = wbLibroOrigen.Worksheets("Lista_Negra_SAT")

uFila = wsHojaOrigen.Range("A" & Rows.Count).End(xlUp).Row

wsHojaOrigen.Range("A1:AD" & uFila).Copy Destination:=wsHojaDestino.Range("DA1")
Workbooks(wbLibroOrigen.Name).Close

Application.ScreenUpdating = True

 

publicado

Buenas , según tu código te paso adaptación:

Sub COPIA()


Application.ScreenUpdating = False
Dim wbLibroOrigen As Workbook
Dim wsHojaOrigen As Worksheet

Dim wbLibroDestino As Workbook
Dim wsHojaDestino As Worksheet
Dim Origen$
Dim ruta() As String

ruta = Split("Lista_Negra_SAT.csv,Lista_Negra_SAT2.csv", ",") ' lista archivos separada por ,

For x = 0 To UBound(ruta)
 Origen = ActiveWorkbook.Path & "\" & ruta(x)
 'Datos destino
 Set wbLibroDestino = Workbooks(ThisWorkbook.Name)
 Set wsHojaDestino = wbLibroDestino.Worksheets("Hoja1")

 'Datos origen
 Set wbLibroOrigen = Workbooks.Open(Origen)
 Set wsHojaOrigen = wbLibroOrigen.Worksheets(Replace(ruta(x), ".csv", ""))

 uFilaO = wsHojaOrigen.Range("A" & Rows.Count).End(xlUp).Row
 uFilaD = wsHojaDestino.Range("DA" & Rows.Count).End(xlUp).Row
 
 wsHojaOrigen.Range("A1:AD" & uFilaO).Copy Destination:=wsHojaDestino.Range("DA" & uFilaD)
 Workbooks(wbLibroOrigen.Name).Close

 Application.ScreenUpdating = True

Next

End Sub

 

Saludos

  

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.