Sub union()
Dim name_aps As String

wizzardname = Excel.ActiveWorkbook.Name
Application.ScreenUpdating = True
  vfile = Application.GetOpenFilename("Files  (*.xls; *.xlsx), *.xls; *.xlsx", , ""
  
    If vfile = False Then
        End
    End If
    
name_of_file = Dir(vfile, 7)

Set nof = Workbooks.Open(vfile)

time1 = Now()

If name_of_file Like "*.xls" Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=vfile & "x", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Kill vfile
Application.DisplayAlerts = True
nof.Close
Workbooks.Open (vfile & "x"
End If


For i = 2 To ActiveWorkbook.Sheets.Count
Sheets(i).Select
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Copy
Sheets(1).Select
Cells(Sheets(1).UsedRange.Rows.Count, 1).Select
ActiveCell.Offset(1, 0).Range("A1".PasteSpecial
Next

Application.DisplayAlerts = False
 For i = Sheets.Count To 2 Step -1
  Sheets(i).Delete
 Next
Application.DisplayAlerts = True

Application.ScreenUpdating = True

ActiveWorkbook.Save
ActiveWindow.Close
End Sub