Сборщик данных не корректно работатет - VBA

Sub LoadDataFromWorkbooks()
    On Error Resume Next: shd.UsedRange.Offset(2).ClearContents
    On Error Resume Next: shd1.UsedRange.Offset(2).ClearContents
    On Error Resume Next: Err.Clear
    Dim AskForFolder As Boolean: AskForFolder = Not shd.OLEObjects("SaveFolderPath").Object.Value
 
    ' запрашиваем пути к папкам с файлами
    msg1$ = "Выберите папку с файлами для обработки"
    InvoiceFolder$ = GetFolder(1, AskForFolder, msg1$)
    If InvoiceFolder$ = "" Then MsgBox "Не задана папка с файлами для обработки", vbCritical, "Обработка заявок невозможна": Exit Sub
 
    Dim coll As Collection
    Set coll = FilenamesCollection(InvoiceFolder$, "*.xls*", 1)
 
    If coll.Count = 0 Then
        MsgBox "Не найдено ни одной заявки для обработки в папке" & vbNewLine & InvoiceFolder$, _
               vbExclamation, "Нет необработанных заявок"
        Exit Sub
    End If
 
    Dim pi As New ProgressIndicator: pi.Show "Обработка заявок", , 2
    pi.StartNewAction , , , , , coll.Count
    Dim WB As Workbook, sh As Worksheet, ra As Range
    Application.ScreenUpdating = False

    For Each Filename In coll

        pi.SubAction "Обрабатывается файл $index из $count", "Файл: " & Dir(Filename), "$time"
        pi.Log "Файл: " & Dir(Filename)

        Set WB = Nothing: Set WB = Workbooks.Open(Filename, False, True)
 
        If WB Is Nothing Then
            pi.Log vbTab & "ОШИБКА при загрузке файла. Файл не обработан."
 
        Else
            Set sh = WB.Worksheets(1)
            Set ra = sh.Range(sh.Range("a3"), sh.Range("a" & sh.Rows.Count).End(xlUp)).Resize(, 50)
            shd.Range("a" & shd.Rows.Count).End(xlUp).Offset(1).Resize(ra.Rows.Count, ra.Columns.Count).Value = ra.Value
            
            Set sh = WB.Worksheets(2)
            Set ra = sh.Range(sh.Range("a100"), sh.Range("a" & sh.Rows.Count).End(xlUp)).Resize(, 70)
            shd1.Range("a" & shd1.Rows.Count).End(xlUp).Offset(1).Resize(ra.Rows.Count, ra.Columns.Count).Value = ra.Value
           
            WB.Close False: DoEvents
            pi.Log vbTab & "Файл успешно обработан."
 
        End If
    Next
 
    pi.Hide: DoEvents: Application.ScreenUpdating = True
    MsgBox "Обработка заявок завершена", vbInformation
End Sub