Copiar un rango de cada libro en una carpeta con VBA en Microsoft Excel
En este artículo, crearemos una macro para copiar datos de varios libros de trabajo en una carpeta a un nuevo libro de trabajo.
Crearemos dos macros; una macro solo copiará los registros de la primera columna al nuevo libro de trabajo y la segunda macro copiará todos los datos en él.
Los datos brutos de este ejemplo consisten en registros de asistencia de los empleados.
En TestFolder, tenemos varios archivos de Excel. Los nombres de los archivos de Excel representan una fecha particular en formato «ddmmyyyy».
Cada archivo de Excel contiene la fecha, la identificación del empleado y el nombre del empleado de los empleados que estuvieron presentes ese día en particular.
Hemos creado dos macros; «CopyingSingleColumnData» y «CopyingMultipleColumnData». La macro «CopyingSingleColumnData» solo copiará los registros de la primera columna de todos los archivos en la carpeta al nuevo libro de trabajo. La macro «CopyingMultipleColumnData» copiará todos los datos de todos los archivos en la carpeta al nuevo libro de trabajo.
La macro «CopyingSingleColumnData» se puede ejecutar haciendo clic en el botón «Copiar una sola columna». La macro «CopyingMultipleColumnData» se puede ejecutar haciendo clic en el botón «Copiar varias columnas».
Antes de ejecutar la macro, hay que especificar la ruta de la carpeta en el cuadro de texto, donde se colocan los archivos de Excel.
Cuando se hace clic en el botón «Copiar una sola columna», se generará un nuevo libro de trabajo «ConsolidatedFile» en la carpeta definida. Este libro de trabajo contendrá datos consolidados de la primera columna de todos los archivos de la carpeta.
El nuevo libro de trabajo contienen solo registros en la primera columna. Una vez que tenemos los datos consolidados, podemos averiguar el número de empleados presentes en un día en particular contando el número de fecha. El conteo de una fecha en particular será igual al número de empleados presentes en ese día.
Cuando se hace clic en el botón «Copiar varias columnas», se generará el nuevo libro de trabajo «ConsolidatedAllColumns» en la carpeta definida. Este libro de trabajo contendrá datos consolidados de todos los registros de todos los archivos de la carpeta.
El nuevo libro de trabajo creado contendrá todos los registros de todos los archivos de la carpeta. Una vez que tenemos los datos consolidados, tenemos todos los detalles de asistencia disponibles en un solo archivo. Podemos encontrar fácilmente la cantidad de empleados presentes ese día en particular y también obtener los nombres de los empleados que estuvieron presentes ese día en particular.
Explicación del código
Sheet1.TextBox1.Value El código anterior se utiliza para insertar el valor en el cuadro de texto «TextBox1» de la hoja «Sheet1».
Dir (Ruta de carpeta & «* .xlsx»)
El código anterior se utiliza para obtener el nombre del archivo, que tiene la extensión «.xlsx». Hemos utilizado comodines * para nombres de archivos de varios caracteres.
Mientras FileName <> «»
Count1 = Count1 + 1 ReDim Preserve FileArray (1 para Count1)
FileArray (Count1) = FileName FileName = Dir ()
El código Wend Above se usa para obtener los nombres de todos los archivos de la carpeta.
Para i = 1 a UBound (FileArray)
Siguiente El código anterior se utiliza para recorrer todos los archivos de la carpeta.
Rango («A1», Celdas (LastRow, 1)). Copiar DestWB.ActiveSheet.Cells (LastDesRow, 1)
El código anterior se usa para copiar el registro de la primera columna al libro de trabajo de destino.
Range («A1», ActiveCell.SpecialCells (xlCellTypeLastCell)). Copiar DestWB.ActiveSheet.Cells (LastDesRow, 1)
El código anterior se usa para copiar todo el registro del libro activo al libro de destino.
Siga a continuación el código
Option Explicit
Sub CopyingSingleColumnData()
'Declaring variables
Dim FileName, FolderPath, FileArray(), FileName1 As String
Dim LastRow, LastDesRow, Count1, i As Integer
Dim SourceWB, DestWB As Workbook
Application.ScreenUpdating = False
FolderPath = Sheet1.TextBox1.Value
'Inserting backslash in the folder path if backslash(\) is missing
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Searching for Excel files
FileName = Dir(FolderPath & "*.xlsx")
Count1 = 0
'Looping through all the Excel files in the folder
While FileName <> ""
Count1 = Count1 + 1
ReDim Preserve FileArray(1 To Count1)
FileArray(Count1) = FileName
FileName = Dir()
Wend
'Creating a new workbook
Set DestWB = Workbooks.Add
For i = 1 To UBound(FileArray)
'Finding the last row in the workbook
LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Opening the Excel workbook
Set SourceWB = Workbooks.Open(FolderPath & FileArray(i))
LastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
'Pasting the copied data to last row in the destination workbook
If LastDesRow = 1 Then
'Copying the first column to last row in the destination workbook
Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Else
Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1)
End If
SourceWB.Close False
Next
'Saving and closing a new Excel workbook
DestWB.SaveAs FileName:=FolderPath & "ConsolidatedFile.xlsx"
DestWB.Close
Set DestWB = Nothing
Set SourceWB = Nothing
End Sub
Sub CopyingMultipleColumnData()
'Declaring variables
Dim FileName, FolderPath, FileArray(), FileName1 As String
Dim LastRow, LastDesRow, Count1, i As Integer
Dim SourceWB, DestWB As Workbook
Application.ScreenUpdating = False
FolderPath = Sheet1.TextBox1.Value
'Inserting backslash in the folder path if backslash(\) is missing
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Searching for Excel files
FileName = Dir(FolderPath & "*.xlsx")
Count1 = 0
'Looping through all the Excel files in the folder
While FileName <> ""
Count1 = Count1 + 1
ReDim Preserve FileArray(1 To Count1)
FileArray(Count1) = FileName
FileName = Dir()
Wend
'Creating a new workbook
Set DestWB = Workbooks.Add
For i = 1 To UBound(FileArray)
'Finding the last row in the workbook
LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Opening the Excel workbook
Set SourceWB = Workbooks.Open(FolderPath & FileArray(i))
'Pasting the copied data to last row in the destination workbook
If LastDesRow = 1 Then
'Copying all data in the worksheet to last row in the destination workbook
Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Else
Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1)
End If
SourceWB.Close False
Next
'Saving and closing a new Excel workbook
DestWB.SaveAs FileName:=FolderPath & "ConsolidatedAllColumns.xlsx"
DestWB.Close
Set DestWB = Nothing
Set SourceWB = Nothing
End Sub
Si te gustó este blog, compártelo con tus amigos en Facebook y Facebook.
Nos encantaría saber de usted, háganos saber cómo podemos mejorar nuestro trabajo y hacerlo mejor para usted. Escríbanos a [email protected]