Amend VBA Code to run through all files within a folder

Good Afternoon

Is it possible to amend the following code to loop through each file in a folder, regardless of the filename?

Many thanks
Sub AppendData()

    Dim wbkMaster As Workbook
    Dim shtMaster As Worksheet
    Dim rngMaster As Range
    Dim wbkData As Workbook
    Dim shtData As Worksheet
    Dim rngData As Range
    
' change path and file name to suit
    Set wbkMaster = Workbooks.Open("D:\temp\testmaster.xls")
    Set shtMaster = wbkMaster.Worksheets(1)
    
' change path and file name to suit
    Set wbkData = Workbooks.Open("D:\temp\test1.xls")
    Set shtData = wbkData.Worksheets(1)
    
' get end of master
    Set rngMaster = shtMaster.Range("A65536").End(xlUp)
' Change as per your need
    Set rngData = shtData.Range("A11:A" & shtData.Range("A11").End(xlDown).Row)
' copy data across
    rngData.Copy rngMaster
    
    MsgBox "Appended " & rngData.Rows.Count & " rows of data to Master data", vbInformation
    
' simply close data
    wbkData.Close False
' save and close master
    wbkMaster.Close True

'  release objects
    Set rngData = Nothing
    Set shtData = Nothing
    Set wbkData = Nothing
    Set rngMaster = Nothing
    Set shtMaster = Nothing
    Set wbkMaster = Nothing
End Sub

Open in new window

WashcareAsked:
Who is Participating?
 
SiddharthRoutConnect With a Mentor Commented:
This uses DIR

Sub AppendData()
    Dim wbkMaster As Workbook, wbkData As Workbook
    Dim shtMaster As Worksheet, shtData As Worksheet
    Dim rngMaster As Range, rngData As Range
    Dim FolderToSearch As String, strPath As String
    
    Set wbkMaster = Workbooks.Open("D:\temp\testmaster.xls")
    Set shtMaster = wbkMaster.Worksheets(1)
    
    '~~> Folder where you want to seach files
    FolderToSearch = "C:\Temp\"
    strPath = FolderToSearch & "*.xls"
    
    strPath = Dir(strPath, vbNormal)
    
    Do While strPath <> ""
        Set wbkData = Workbooks.Open(FolderToSearch & strPath)
        Set shtData = wbkData.Worksheets(1)
        
        Set rngMaster = shtMaster.Range("A65536").End(xlUp)
        Set rngData = shtData.Range("A11:A" & shtData.Range("A11").End(xlDown).Row)
        rngData.Copy rngMaster
        
        MsgBox "Appended " & rngData.Rows.Count & " rows of data to Master data", vbInformation
        
        wbkData.Close False
        strPath = Dir
    Loop
    
    wbkMaster.Close True

    Set rngData = Nothing
    Set shtData = Nothing
    Set wbkData = Nothing
    Set rngMaster = Nothing
    Set shtMaster = Nothing
    Set wbkMaster = Nothing
End Sub

Open in new window


Sid
0
 
jppintoCommented:
Please check this code to see if you can find what you're looking for:

http://excel-user.blogspot.com/2009/10/replace-value-on-several-excel-files.html

jppinto
0
 
WashcareAuthor Commented:
Sid

Thank you for the amendment. At some point in the code I think I need testmaster.xls, to be saved and closed before moving onto the next file, otherwise the changes will be lost?

Many thanks
0
 
WashcareAuthor Commented:
Sorry

I have moved testmaster.xls out of the folder which I am looping through issue resolved.

Thank you
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.