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.

ArrowMain

 

ArrowFilesInFolder

 

ArrowRawData

 
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.

 

ArrowOutput

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

Users are saying about us...

Leave a Reply

Your email address will not be published. Required fields are marked *

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>

Terms and Conditions of use

The applications/code on this site are distributed as is and without warranties or liability. In no event shall the owner of the copyrights, or the authors of the applications/code be liable for any loss of profit, any problems or any damage resulting from the use or evaluation of the applications/code.

Visit Us On TwitterVisit Us On FacebookVisit Us On Google PlusVisit Us On Youtube