Copie un rango de cada libro de trabajo en una carpeta usando VBA en Microsoft Excel

Tabla de contenido

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 contendrá 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 recuento de una fecha en particular será igual al número de empleados presentes en ese día en particular.

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 y "* .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 que FileName ""

Count1 = Count1 + 1

ReDim Preserve FileArray (1 para contar1)

FileArray (Count1) = Nombre de archivo

Nombre de archivo = Dir ()

Encaminarse a

El código anterior se usa para obtener los nombres de todos los archivos de la carpeta.

Para i = 1 a UBound (FileArray)

próximo

El código anterior se usa 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 de trabajo activo al libro de trabajo de destino.

Siga a continuación para obtener el código

 Option Explicit Sub CopyingSingleColumnData () 'Declarando 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' Insertar barra invertida en la ruta de la carpeta si falta la barra invertida (\) If Right (FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Buscando archivos de Excel FileName = Dir (FolderPath & "* .xlsx") Count1 = 0 'Recorriendo todos los archivos de Excel en la carpeta While FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Creando un nuevo libro de trabajo Set DestWB = Workbooks.Add For i = 1 To UBound (FileArray) 'Buscando la última fila en el libro de trabajo LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row' Abriendo el libro de Excel Set SourceWB = Workbooks.Open (Ruta de carpeta y matriz de archivos (i)) LastRow = ActiveCell.SpecialCells (xlCellTypeLas tCell) .Row 'Pegar los datos copiados en la última fila del libro de trabajo de destino Si LastDesRow = 1 Then' Copiar la primera columna en la última fila del libro de trabajo de destino Range ("A1", Cells (LastRow, 1)). Copiar DestWB. ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", Cells (LastRow, 1)). Copiar DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Guardar y cerrar un nuevo Excel libro de trabajo DestWB.SaveAs FileName: = FolderPath & "ConsolidatedFile.xlsx" DestWB.Close Set DestWB = Nothing Set SourceWB = Nothing End Sub Sub CopyingMultipleColumnData () 'Declarando variables Dim FileName, FolderPath, FileArray (), FileName1 como cadena Dim LastRow, LastDesRow , Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Insertar barra invertida en la ruta de la carpeta si falta la barra invertida (\) If Right (FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Buscando archivos de Excel FileName = Dir (FolderPath & "* .xlsx") Count1 = 0 'Recorriendo todos los archivos de Excel en la carpeta While FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Creando un nuevo libro de trabajo Establecer DestWB = Workbooks.Add For i = 1 To UBound (FileArray) 'Buscando la última fila en el libro de trabajo LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row' Abriendo el libro de Excel Set SourceWB = Workbooks.Open (FolderPath & FileArray (i)) 'Pegando los datos copiados en la última fila del libro de trabajo de destino Si LastDesRow = 1 Then' Copiando todos los datos de la hoja de trabajo en la última fila del libro de trabajo de destino Range ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Copiar DestWB.ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Copiar DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Guardar y cerrar un nuevo libro de Excel DestWB.SaveAs FileName: = FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set D estWB = Nada configurado SourceWB = Nada End Sub 

Si te gustó este blog, compártelo con tus amigos en Facebook. Además, puede seguirnos en Twitter y Facebook.

Nos encantaría saber de usted, háganos saber cómo podemos mejorar nuestro trabajo y hacerlo mejor para usted. Escríbanos al sitio de correo electrónico

Va a ayudar al desarrollo del sitio, compartir la página con sus amigos

wave wave wave wave wave