VBA code with potentially corrupted files

I have the following code. I took it from MRexcel, it seems they aren't interested in helping further. I have been trying various solutions with no luck. I believe some of the files to be corrupt in a way that does not allow the macro to run properly. Its basically looping through a folder and combining all the data into one spreadsheet. Its doing two things that are wrong.

1. It is only pulling through filtered data in the file. I need it to pull all data regardless of filter.
2. It is not pulling every file that in the folder, if I take the data of that file and save it over a good file that does pull through, then the data pulls through just fine. Is there a way to fix this?

Here is what I have so far.

Sub combine_multiple_workbooks()
  Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
  Dim sFile As Variant, sPath As String, LastRow1 As Long, LastRow2 As Long
  Dim sh As Worksheet

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  Set wb1 = ThisWorkbook
  Set sh1 = wb1.Sheets("Summary")
  sh1.Cells.ClearContents
  sh1.Range("A1").Value = "File"
  sPath = "C:\Users\jordan.burch.ctr\Desktop\TEST\"
  sFile = Dir(sPath & "Phase1*.xls*")
  On Error Resume Next
  Do While sFile <> ""
    Set wb2 = Workbooks.Open(sPath & sFile)

    Workbooks.Open Filename:=sPath & sFile, ReadOnly:=True, IgnoreReadOnlyRecommended:=True, CorruptLoad:=xlExtractData
    For Each sh In wb2.Sheets
      If sh.Visible = -1 Then
        Set sh2 = wb2.Sheets(1)
        Exit For
      End If
    Next
    LastRow2 = sh2.Range("B"& Rows.Count).End(xlUp).Row
    LastRow1 = sh1.Range("B"& Rows.Count).End(xlUp).Row + 1
    sh2.Range("A2:AE"& LastRow2).Copy
    sh1.Range("B"& LastRow1).PasteSpecial xlPasteAll
    sh1.Range("A"& LastRow1).Resize(LastRow2 - 1).Value = sFile

    wb2.Close False
    sFile = Dir()
  Loop
End Sub

ANy help is greatly appreciated.