Problem with the combine all Excel files in one

[Vagelisr]

Hi to all.
I want in my excel files to do 2 diff jobs.
The first one is to open a specific folder, find all Excel files, open and copy the data from a specific sheet and paste then in my main excel file (Merge Sub)
The second one is to take my main excel files and when the data from the a parameter column change save them in a new excel files (Split Sub)
The problem is: Using the merge sub everything shows that work OK but when i use also the split sub the Excel that creating from this Sub Freeze when i try to close them.
The same happens also when i make a copy paste myself in a new excel. (I make a test in the split subroutine and work without problem).
So the problem is in my Merge Sub and here i want your help.

Thank you all for your time.......

This is the code i use

Option Explicit
Public Folder As String
Public FirstExcel As Boolean

Sub Merge()
    Dim arg As String
    Dim LastMainRow As Integer
    Dim FirstLine As Integer
    Dim myExtension As String
    Dim fname As String
    Dim myfiles As String
    Dim lRow As Integer
    Dim lCol As Integer
    Dim FirstCol As Integer
    Dim WorkSheetName As String
    FirstLine = Worksheets("Parm").Cells(2, 2).Value + 1
    WorkSheetName = Worksheets("Parm").Cells(4, 2).Value
    Folder = BrowseForFolder & "\"
    If Folder <> "" Then
        myExtension = "*.xls"
        myfiles = Dir(Folder & myExtension)
        'Row = 1
        FirstCol = 1
        Worksheets("DataAll").Activate
        ActiveSheet.Cells.Clear
        FirstExcel = False
        Do While myfiles <> ""
            'Open the Specific Excell
            Workbooks.Open (Folder & myfiles)
            'ActiveWorkbook.RunAutoMacros xlAutoOpen
            fname = ActiveWorkbook.Name
            
            'Copy the Specific Excell
            Workbooks(myfiles).Activate
            Worksheets(WorkSheetName).Activate
            If FirstExcel = False Then
                ActiveSheet.Cells.Select
                Selection.Copy
            Else
                lRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'Last Row
                lCol = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column 'Last Column
                ActiveSheet.Range(ActiveSheet.Cells(FirstLine, FirstCol), ActiveSheet.Cells(lRow, lCol)).Select
                Selection.Copy
            End If
             
            'Paste the Specific Excell to Data
            Workbooks("File_Merge_Split.xls").Activate
            Worksheets("DataAll").Activate
            LastMainRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'Last Row
            If FirstExcel = True Then
                LastMainRow = LastMainRow + 1
            Else
                FirstExcel = True
            End If
            ActiveSheet.Cells(LastMainRow, 1).Select
            ActiveSheet.Paste
            
            'Close Copy File
            Application.DisplayAlerts = False
            Workbooks(myfiles).Close SaveChanges:=False
            Application.DisplayAlerts = True
            
            myfiles = Dir
        Loop
    End If
End Sub

Sub Split()
    Dim lRow As Integer
    Dim lCol As Integer
    Dim i As Integer
    Dim First_Range_Line As Integer
    Dim Last_Range_Line As Integer
    Dim Compare_Data As String
    Dim New_Excel_Column_Name1 As String
    Dim New_Excel_Column_Name2 As String
    Dim New_Excel_Name As String
    Dim PathForSave As String
    Dim Change_Column As String
    Dim Current_Workbook_Name As String
    Dim New_Workbook_Name As String
    Dim SumiRow As Integer
    
    Current_Workbook_Name = ActiveWorkbook.Name
    
    First_Range_Line = Worksheets("Parm").Cells(2, 2).Value + 1 '4
    New_Excel_Column_Name1 = Worksheets("Parm").Cells(5, 2).Value 'A
    New_Excel_Column_Name2 = Worksheets("Parm").Cells(5, 3).Value 'B
    Change_Column = Worksheets("Parm").Cells(3, 2).Value 'A
    New_Workbook_Name = Worksheets("Parm").Cells(4, 2).Value 'Data
    
    Worksheets("DataAll").Activate
    PathForSave = Application.ActiveWorkbook.Path & "\"
    
    Compare_Data = ActiveSheet.Cells(First_Range_Line, Change_Column).Value
    lRow = ActiveSheet.Range(Change_Column & Rows.Count).End(xlUp).Row 'Last Row
    lCol = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column 'Last Column
    For i = 5 To lRow + 1
        If ActiveSheet.Cells(i, Change_Column).Value <> Compare_Data Then
            New_Excel_Name = ActiveSheet.Cells(i - 1, New_Excel_Column_Name1).Value & "-" & ActiveSheet.Cells(i - 1, New_Excel_Column_Name2).Value
            'Copy_Header
            ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(3, lCol)).Select
            Selection.Copy
            
            'Create New Excel with Name
            Workbooks.Add
            ActiveSheet.Name = New_Workbook_Name
            'Paste_Header
            ActiveSheet.Paste
            ActiveWorkbook.SaveAs PathForSave & New_Excel_Name
            
            Workbooks(Current_Workbook_Name).Activate

            Worksheets("DataAll").Activate
            Last_Range_Line = i - 1
            'Copy_Data
            ActiveSheet.Range(ActiveSheet.Cells(First_Range_Line, 1), ActiveSheet.Cells(Last_Range_Line, lCol)).Select
            Selection.Copy
            
            'Paste_Data
            Workbooks(New_Excel_Name & ".xls").Activate '------------------
            Worksheets(New_Workbook_Name).Activate
            ActiveSheet.Cells(4, 1).Select
            ActiveSheet.Paste
            
            'Save & Close New Excel
            SumiRow = ActiveSheet.Range(Change_Column & Rows.Count).End(xlUp).Row 'Last Row for Sum
            ActiveSheet.Cells(2, 62).Formula = "=SUM(BJ4:BJ" & SumiRow & ")"
            
            Application.DisplayAlerts = False
            ActiveWorkbook.Close SaveChanges:=True
            Application.DisplayAlerts = True
         
            Compare_Data = ActiveSheet.Cells(i, Change_Column).Value
            First_Range_Line = i
         
        End If
    Next i
End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Ðáñáêáëþ åðéëÝîôå öÜêåëï", 0, OpenAt)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
    Set ShellApp = Nothing
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
    Exit Function
Invalid:
    BrowseForFolder = False
End Function