¿Cómo Importar datos desde varios libros y organizarlos en tabla normalizada?

Necesito importar datos desde varios libros de Excel (.xlsm) y pegarlos en una misma tabla, normalizada, si posible. Tengo como base, una macro VBA de 'Importar datos desde varios libros', la cual he tratado de adaptar para mi necesidad, el problema que tengo o duda es:

¿Cómo crear un contador o 'for' para las columnas, para lograr que los datos (una sola columna, "F3:F32" por excel) se peguen en columnas y no por filas?

La descripción de mi pregunta:

1. Tengo varios EXCEL's

En realidad son más de 300 archivos,

2. La macro de Importar datos :

Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
' Modify this folder path to point to the files you want to use.
FolderPath = "E:\macro Excel VBA\ejemplo MSN amincis CE\data\"
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*MSN????.xlsm")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)
' Set the cell in column A to be the file name.
SummarySheet.Range("A" & NRow).Value = FileName
' Set the source range to be A9 through C9.
' Modify this range for your workbooks.
' It can span multiple rows.
Set SourceRange = WorkBk.Worksheets("Saisie mesures").Range("F3:F32")
' Set the destination range to start at column B and
' be the same size as the source range.
Set DestRange = SummarySheet.Range("B" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()
Loop
' Call AutoFit on the destination sheet so that all
' data is readable.
SummarySheet. Columns. AutoFit
End Sub

3. Las pistas que tengo son :

-Crear otra línea homologa al NRow pero que funcione con Columnas, ""NColumn"

-Copiar celda por celda y repetir la operación (nada practica)

-Crear algo que pueda pegar y TRANSPONER al mismo tiempo.

1 Respuesta

Respuesta

No entiendo bien lo que quieres.

La sub actual te copia en la columna B del nuevo libro el rango(F3:F32) de cada libro, poniéndolos cada vez a continuación del anterior, pero siempre en la columna B.

Me imagino que lo que quieres es ir pegando la columna F de cada libro, en la columna siguiente ¿no?

Prueba estas modificaciones: (las he puesto en negrilla)

Si no es esto lo que quieres dimelo.

Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String

Dim NCol As Long

Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
' Modify this folder path to point to the files you want to use.
FolderPath = "E:\macro Excel VBA\ejemplo MSN amincis CE\data\"
' NRow keeps track of where to insert new rows in the destination workbook.

NCol = 1

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*MSN????.xlsm")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)
' Set the cell in column A to be the file name.

SummarySheet.Cells(1, NCol).Value = FileName

' Set the source range to be A9 through C9.
' Modify this range for your workbooks.
' It can span multiple rows.
Set SourceRange = WorkBk.Worksheets("Saisie mesures").Range("F3:F32")
' Set the destination range to start at column B and
' be the same size as the source range.

Set DestRange = SummarySheet.Cells(2, NCol)

Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
' Increase NRow so that we know where to copy data next.

NCol= NCol + 1

' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()
Loop
' Call AutoFit on the destination sheet so that all
' data is readable.
SummarySheet. Columns. AutoFit
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas