Copiar algunos rangos de varios libros de excel a otro libro
He visto tus macros y veo que eres genial realizándolos.
Tengo un problema, con una macro que copie y modifique, la macro fue realizada por ti, pero al parecer no me funciona bien.
* Tengo en una carpeta una carpeta con 20 documento de excel, los mismo son completados por usuarios, estos documentos tienen el mismo formato, la única variante es que lo llenan departamentos diferentes.
*Tengo otro libro de excel que es mi programa general en el cual necesito copiar todos esos 20 documentos. Pero solo necesito los siguientes rangos:
Columna A2:A500 y G2:L500
Ejecuto el macro y me saltan las líneas y en otros casos me copia todo desde la fila 1, el jala la información pero no organizada.
Dejame saber si puedes ayudarme
En espera de su respuesta
Debajo el macro modificado
Sub CopiarRangos()
'Por.Dante Amor
'copia rangos de hojas de libros en un libro
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
l1.Sheets.Add
Set h1 = l1.ActiveSheet
'
Set nav = CreateObject("shell.application")
carp = nav.browseforfolder(0, "SELECCIONA CARPETA", 0, "C:\Users\ctorres\Desktop").items.Item.Path
If carp = "" Then Exit Sub
ChDir carp
'
archi = Dir("*.xls*")
J = 1
Do While archi <> ""
Set l1 = Workbooks.Open(archi)
For Each h In l1.Sheets
h.Range("A2:A200").Copy h1.Range("A2" & J)
J = J + 1
h.Range("G2:L200").Copy h1.Range("G2" & J)
J = J + 1
Next
l1.Close False
archi = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Hojas concentrados"
End Sub