Sub M_ExceL()
Dim fnameList As Variant
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook
Dim rng As Range
fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
If (vbBoolean <> VarType(fnameList)) Then
If (UBound(fnameList) > 0) Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbkCurBook = ActiveWorkbook
For Each fnameCurFile In fnameList
Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
Set wksCurSheet = wbkSrcBook.Sheets(1)
lstr = wbkCurBook.Sheets(1).Cells(Rows.Count, 1).End(3).Row
If (lstr = 1) Then
Set rng = wksCurSheet.UsedRange
Else
Set rng = wksCurSheet.UsedRange.Offset(1, 0)
lstr = lstr + 1
End If
rng.Copy: wbkCurBook.Sheets(1).Range("a" & lstr).PasteSpecial (xlPasteValues)
Application.DisplayAlerts = False
wbkSrcBook.Close SaveChanges:=False
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Merged " & UBound(fnameList) & " Files", Title:="Merge Excel files"
End If
Else
MsgBox "No files selected", Title:="Merge Excel files"
End If
Application.DisplayAlerts = True
End Sub
کامنت