Current and New Workbook Issue|VBA & Macros|Excel Forum|My Online Training Hub

Hello

I have some code below which loops through a directory and opens a totally new workbook each time the code is run.

I seek help to modify the code so that the results return in the original workbook where the code is run from not in a totally new workbook.

Any help appreciated 🙂

Sub MergeAllWorkbooks()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
   
    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
   
    ' Modify this folder path to point to the files you want to use.
    FolderPath = "C:\Users\Learning2\Track\"
   
    ' NRow keeps track of where to insert new rows in the destination workbook.
    NRow = 1
   
    ' Call Dir the first time, pointing it to all Excel files in the folder path.
    FileName = Dir(FolderPath & "*.xl*")
   
    ' Loop until Dir returns an empty string.
    Do While FileName <> ""
        ' Open a workbook in the folder
        Set WorkBk = Workbooks.Open(FolderPath & FileName)
       
        ' Set the cell in column A to be the file name.
        SummarySheet.Range("A" & NRow).Value = FileName
       
        ' Set the source range to be A9 through C9.
        ' Modify this range for your workbooks.
        ' It can span multiple rows.
        Set SourceRange = WorkBk.Worksheets(1).Range("A9:C9")
       
        ' Set the destination range to start at column B and
        ' be the same size as the source range.
        Set DestRange = SummarySheet.Range("B" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
           SourceRange.Columns.Count)
          
        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value
       
        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count
       
        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
       
        ' Use Dir to get the next file name.
        FileName = Dir()
    Loop
   
    ' Call AutoFit on the destination sheet so that all
    ' data is readable.
    SummarySheet.Columns.AutoFit
End Sub