Combine all sheets from different workbooks in 1 Summary Sheet.

[countryfan_nt]

Hello friends! Hope all is well,

I have the 2 codes below, that work smoothly, and must be applied in order. The codes in short combine the sheets’ contents of different workbooks into 1 sheet.

The codes may need some adjustment to avoid the below challenges:
The problem are:
1. The sheets will not capture all the rows if there are spaces between rows.
2. Code will not fully work if there is any type of cell merging.

Please help me adjust/improve the codes, and ensure that all the contents of all the sheets are added to the Summary sheet please.

Thank you very very much in advance!

Sub MergeWorkbooks()
   Dim wbkCur As Workbook
   Dim wbkAdd As Workbook
   Dim strPath As String
   Dim strFile As String
   Set wbkCur = ActiveWorkbook
   With Application.FileDialog(msoFileDialogFolderPicker)
     If .Show Then
       strPath = .SelectedItems(1)
     Else
       MsgBox "You didn't select a folder!", vbExclamation
       Exit Sub
     End If
   End With
   'Application.ScreenUpdating = False
   If Right(strPath, 1) <> "\" Then
     strPath = strPath & "\"
   End If
   strFile = Dir(strPath & "*.xls*")
   Do While strFile <> ""
     Set wbkAdd = Workbooks.Open(strPath & strFile)
     wbkAdd.Worksheets.Copy After:=wbkCur.Worksheets(wbkCur.Worksheets.Count)
     wbkAdd.Close SaveChanges:=False
     strFile = Dir
   Loop
   'Application.ScreenUpdating = True
End Sub

Sub Copy_All_Sheets_To_Summary()
Dim ws As Worksheet
'Application.ScreenUpdating = False
For Each ws In Worksheets
With ws
If .Name <> "Summary" Then
.Activate
.Range([A1], ActiveSheet.UsedRange).Copy _
Sheets("Summary").[A1048576].End(xlUp)(2)
End If
End With
Next
End Sub