Copiar celdas de todos los libros en una carpeta con VBA en Microsoft Excel
En este artículo, crearemos una macro para copiar celdas a todos los libros de trabajo en una carpeta.
Hemos utilizado algunos archivos de ejemplo de Excel como datos sin procesar. Estos archivos contienen detalles de asistencia de los empleados. Cada archivo contiene la fecha, la identificación del empleado y el nombre de los empleados. Queremos agregar encabezados a todos los archivos dentro de la carpeta.
Al ejecutar la macro, los datos en el rango de H8 a J10 se pegarán como encabezado en todas las hojas de Excel dentro de la carpeta.
Explicación del código
FolderPath = Sheet1.TextBox1.Value El código anterior se usa para asignar un valor en el cuadro de texto para mencionar la variable.
Dir (Ruta de carpeta & «* .xlsx»)
El código anterior se utiliza para obtener el nombre de archivo del primer archivo dentro de la ruta de la carpeta especificada.
Mientras FileName <> «»
Count1 = Count1 + 1 ReDim Preserve FileArray (1 para Count1)
FileArray (Count1) = FileName FileName = Dir ()
Wend El código anterior se utiliza para crear una matriz de cadenas. Contiene los nombres de todos los archivos dentro de la carpeta.
Workbooks.Open (FolderPath & FileArray (i))
El código anterior se utiliza para abrir el libro de trabajo especificado.
SourceWB.Worksheets (1) .Range («H8: J10»). Copiar DestWB.Worksheets (1) .Range («A1: C3»)
El código anterior se usa para copiar el encabezado del libro de trabajo principal a otros libros de trabajo.
Siga el código a continuación
Option Explicit
Sub CopyingDataToFilesInFolder()
'Declaring variables
Dim FileName, FolderPath, FileArray() As String
Dim Count1, i As Integer
Dim SourceWB, DestWB As Workbook
'Getting folder path from the text box
FolderPath = Sheet1.TextBox1.Value
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Getting the file name from the folder
FileName = Dir(FolderPath & "*.xlsx")
Count1 = 0
'Creating an array which consists of file name of all files in the folder
While FileName <> ""
Count1 = Count1 + 1
ReDim Preserve FileArray(1 To Count1)
FileArray(Count1) = FileName
FileName = Dir()
Wend
Set SourceWB = ThisWorkbook
For i = 1 To UBound(FileArray)
'Opening the workbook
Set DestWB = Workbooks.Open(FolderPath & FileArray(i))
'Pasting the required header
SourceWB.Worksheets(1).Range("H8:J10").Copy DestWB.Worksheets(1).Range("A1:C3")
'Closing the workbook
DestWB.Close True
Next
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]