Copy cells to all workbooks in a folder using VBA in Microsoft Excel

In this article, we will create a macro to copy cells to all workbooks in a folder.

We have used some sample Excel files as raw data. These files contain attendance details of the employees. Each file contains Date, Employee id and Name of the employees. We want to add headers to all the files within the folder.

 
On running the macro, data in the range H8 to J10 will be pasted as a header in all the Excel sheets within the folder.

Code explanation

FolderPath = Sheet1.TextBox1.Value

The above code is used to assign value in the textbox to mention variable.

Dir(FolderPath & "*.xlsx")

The above code is used to get the file name of the first file within the specified folder path.

While FileName <> ""

Count1 = Count1 + 1

ReDim Preserve FileArray(1 To Count1)

FileArray(Count1) = FileName

FileName = Dir()

Wend

The above code is used to create a string array. It contains file names of all the files within the folder.

Workbooks.Open(FolderPath & FileArray(i))

The above code is used to open the specified workbook.

SourceWB.Worksheets(1).Range("H8:J10").Copy DestWB.Worksheets(1).Range("A1:C3")

The above code is used to copy header from the main workbook to other workbooks.

Please follow below for the code

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

If you liked this blog, share it with your friends on Facebook. Also, you can follow us on Twitter and Facebook.

We would love to hear from you, do let us know how we can improve our work and make it better for you. Write to us at info@exceltip.com