Merging multiple files into one file

[Edberg]

I am using the following code which I found in google and its working good if I open blank sheet1 workbook, open the macro, paste this code and run it.
But its not working if I save this macro as add-in and open another excel, run this add-in.
I guess there is something to do with ThisWorkbook function, any suggestion please. Thank You.
Meanwhile I am saving this code in "ThisWorkbook" of VBAproject.

Code I am using:

Option Explicit

Sub Consolidate()


Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet


'Setup
    Application.ScreenUpdating = False  'speed up macro execution
    Application.EnableEvents = False    'turn off other macros for now
    Application.DisplayAlerts = False   'turn off system messages for now
    
    Set wsMaster = ThisWorkbook.Sheets("Sheet1")    'sheet report is built into


With wsMaster
    If MsgBox("Press Yes to Clear data in the current Sheet or Press No to Exit", vbYesNo) = vbYes Then
        .UsedRange.Offset(1).EntireRow.Clear
        NR = 2
    Else
        Exit Sub
    End If


'Path and filename (edit this section to suit)
    fPath = "C:\Users"
    
    'remember final \ in this string
    fPathDone = fPath & "Imported\"     'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                 'creates the completed folder if missing
    On Error GoTo 0
    fName = Dir(fPath & "*.csv*")        'listing of desired files, edit filter as desired


'Import a sheet from found files
    Do While Len(fName) > 0
        If fName <> ThisWorkbook.Name Then              'don't reopen this file accidentally
            Set wbData = Workbooks.Open(fPath & fName)  'Open file


        'This is the section to customize, replace with your own action code as needed
            LR = Range("A" & Rows.Count).End(xlUp).Row  'Find last row
            Range("A2:A" & LR).EntireRow.Copy .Range("A" & NR)
            wbData.Close False                                'close file
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
            Name fPath & fName As fPathDone & Format(Now, "yyyy-mm-dd h-mm-ss") & "_" & fName           'move file to IMPORTED folder
        End If
        fName = Dir                                       'ready next filename
    Loop
End With


Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FileExists("C:\Users\Final.csv") = True Then
Name fPath & "Append\Final" & ".csv" As fPath & "Append\Final" & "_" & Format(Now, "yyyy-mm-dd h-mm-ss") & ".csv"
End If


ActiveWorkbook.SaveAs Filename:=fPath & "Append\Final" & ".csv", _
                    FileFormat:=xlCSV, CreateBackup:=False
                ActiveWorkbook.Close False
                
                
ErrorExit:    'Cleanup
    
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
End Sub

 

[bhos123]

Try replacing this workbook to activeworkbook

 

[Edberg]

Try replacing this workbook to activeworkbook

It worked,Thanks alot.