VBA Macro for autoloading files and processing them

workbookcreator.vba

Sub workbookcreator()
    Dim MyPath As String, FilesInPath As String, Outputpath As String
    Dim MyFiles() As String, dd() As String, columnsname As String
    Dim FNum As Long, kk As Long, no_ent As Long
    Dim mybook As Workbook
    Dim sheetsname As Variant, ee() As Variant
    Application.AskToUpdateLinks = False
    ' Change this to the path\folder location of your files.
    MyPath = "path to data files\data"
    Outputpath = "path to output folder\output"
    ' Add a slash at the end of the path if needed.
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    ' Add a slash at the end of the path if needed.
    If Right(Outputpath, 1) <> "\" Then
        Outputpath = Outputpath & "\"
    End If
    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.xl*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    ' Fill the myFiles array with the list of Excel files
    ' in the search folder.
    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop
   If FNum > 0 Then
    For FNum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    Workbooks.Open (MyPath & MyFiles(FNum))
    Workbooks.Open ("path to template file\template.xlsm")
    
    Dim i As Long
    Application.Calculation = xlCalculationManual
    On Error GoTo ErrMergeAll
    Application.DisplayAlerts = False
    Windows(MyFiles(FNum)).Activate
    Worksheets(1).Activate
    Range("A2:E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("template.xlsm").Activate
    Sheets("data").Select
    Range("A2").Select
    ActiveSheet.Paste
    numberofrows = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Sheets("macro").Select
    i = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("e2:e3").Select
    Selection.Value = numberofrows
    Range("A1:F" & i).Select
    'uncomment the next line if you want to link range calculations to some formula
    'Selection.Calculate
    Application.Run "'template.xlsm'!dynamicrange"
    Calculate
    dd = Split(MyFiles(FNum), ".")
    ActiveWorkbook.SaveAs Outputpath & dd(0) & ".xlsm", FileFormat:=52
    ActiveWindow.Close
      Next FNum
    End If
    Application.AskToUpdateLinks = True

ErrMergeAll:
    MsgBox Err.Description, vbInformation
    Application.DisplayAlerts = True
End Sub