Copiar filas enteras de muchos archivos en una sola hoja
Publicado por Ziguli (1 intervención) el 28/08/2015 12:27:19
Buenas,
Estoy intentando realizar una macro que permita copiar filas enteras a un archivo matriz. Tengo muchas listas (cada lista un archivo) con un mismo formato y quiero agruparlas de forma ordenada (una encima la otra) en una sola hoja de un archivo. Soy muy novato en el mundo macros, entiendo el lenguaje pero me faltan muchos recursos y repertorio.
La idea que tengo es ir abriendo archivo por archivo e ir copiando todas sus filas a partir de la fila donde estan los datos hasta llegar a la fila vacía. Los datos se irían copiando a la hoja matriz, donde se iran acumulando ordenadamente gracias a un contador de fila. En concreto quiero copiar a partir de la fila 3 hasta la fila vacía. Mi idea es que no parece ser algo difícil (en el concepto), por eso estoy seguro que entre todos me podréis echar un cable.
Os adjunto mi ejemplo. Como veréis utilizo el archivo "UnirIndices" para la macro, y creo el archivo matriz con el nombre "Indunidos"
Críticas y ayudas son más que bien recibidas! Muchísimas Gracias! Saludos
Sub UnirIndices()
Dim Directorio As String
Dim ContadorFicheros As String
Dim Indunidos As Workbook
Dim Libro As Workbook
Dim frase As String
Dim m As Integer
Dim i As Integer
Directorio = ThisWorkbook.Path
ContadorFicheros = Dir$(Directorio + "\*.*")
'Crea el libro que contendrá a todos los demás
Application.SheetsInNewWorkbook = 1
Set Indunidos = Application.Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Directorio & "\" & "Indunidos.xlsx"
m = 0
i = 3
Do While ContadorFicheros <> "" And UCase(ContadorFicheros) <> "UnirIndices.XLSM"
Workbooks.Open Filename:=Directorio & "\" & ContadorFicheros
Set Libro = Workbooks(ContadorFicheros)
frase = Libro.Worksheets(1).Cells(i, 3).Value
'Do While Libro.Worksheets(1).Cells(i, 3) <> ""
'Libro.Worksheets(1).Rows(i).EntireRow.Copy
' i = i + 1
' MsgBox i
' Set Indunidos = ActiveWorkbook
' Indunidos.Sheets(1).Cells(m, 1).Select
' Indunidos.Sheets(1).Paste
' m = m + 2
' Loop
Workbooks(ContadorFicheros).Close
ContadorFicheros = Dir$
Loop
End Sub
Estoy intentando realizar una macro que permita copiar filas enteras a un archivo matriz. Tengo muchas listas (cada lista un archivo) con un mismo formato y quiero agruparlas de forma ordenada (una encima la otra) en una sola hoja de un archivo. Soy muy novato en el mundo macros, entiendo el lenguaje pero me faltan muchos recursos y repertorio.
La idea que tengo es ir abriendo archivo por archivo e ir copiando todas sus filas a partir de la fila donde estan los datos hasta llegar a la fila vacía. Los datos se irían copiando a la hoja matriz, donde se iran acumulando ordenadamente gracias a un contador de fila. En concreto quiero copiar a partir de la fila 3 hasta la fila vacía. Mi idea es que no parece ser algo difícil (en el concepto), por eso estoy seguro que entre todos me podréis echar un cable.
Os adjunto mi ejemplo. Como veréis utilizo el archivo "UnirIndices" para la macro, y creo el archivo matriz con el nombre "Indunidos"
Críticas y ayudas son más que bien recibidas! Muchísimas Gracias! Saludos
Sub UnirIndices()
Dim Directorio As String
Dim ContadorFicheros As String
Dim Indunidos As Workbook
Dim Libro As Workbook
Dim frase As String
Dim m As Integer
Dim i As Integer
Directorio = ThisWorkbook.Path
ContadorFicheros = Dir$(Directorio + "\*.*")
'Crea el libro que contendrá a todos los demás
Application.SheetsInNewWorkbook = 1
Set Indunidos = Application.Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Directorio & "\" & "Indunidos.xlsx"
m = 0
i = 3
Do While ContadorFicheros <> "" And UCase(ContadorFicheros) <> "UnirIndices.XLSM"
Workbooks.Open Filename:=Directorio & "\" & ContadorFicheros
Set Libro = Workbooks(ContadorFicheros)
frase = Libro.Worksheets(1).Cells(i, 3).Value
'Do While Libro.Worksheets(1).Cells(i, 3) <> ""
'Libro.Worksheets(1).Rows(i).EntireRow.Copy
' i = i + 1
' MsgBox i
' Set Indunidos = ActiveWorkbook
' Indunidos.Sheets(1).Cells(m, 1).Select
' Indunidos.Sheets(1).Paste
' m = m + 2
' Loop
Workbooks(ContadorFicheros).Close
ContadorFicheros = Dir$
Loop
End Sub
Valora esta pregunta
0
