Help with VBA that no longer works

[Serafin54]

Hello. I have the VBA below that up until a few months back worked perfectly. Now it just flashes showing its running but it isn't doing anything so I am quite confused by that. The VBA would in essence, open the file picker allowing you to combine one workbook with multiple sheets or multiple files, then take the workbook or workbooks and then combine them based on the headers and also add in headers that weren't previously found in earlier sheets/workbooks. I haven't the foggiest as to why all of a sudden it stopped running and have tried with different workbooks and using just a single file as well to see if it is just the one but it's every file i try. Thanks for looking.

Sub Consolidate_Files()
Dim rngHdr As Range, HdrsToCopy As Range, DestRow As Range
Dim AllHeaders()
ReDim AllHeaders(0 To 0)
With ActiveWorkbook
  Set DestSheet = .Sheets.Add(after:=.Sheets(.Sheets.Count))
End With  'Activeworkbook
With DestSheet
  Set DestRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)  'or any other column.
End With  'DestSheet
filenames = Application.GetOpenFilename("Excel files,*.xls*", MultiSelect:=True)
If IsArray(filenames) Then
  For Each fName In filenames
    Set WkBk = Workbooks.Open(fName)
    For Each sht In WkBk.Sheets
    
    If sht.Name = "Final" Then
    
      rowscount = sht.UsedRange.Rows.Count - 1
      For Each cll In sht.Rows(1).SpecialCells(xlCellTypeConstants, xlTextValues).Cells
        NewHeader = False
        HeaderColumn = 0
        For i = LBound(AllHeaders) To UBound(AllHeaders)
          If AllHeaders(i) = cll.Value Then
            HeaderColumn = i
            Exit For
          End If
        Next i
        If HeaderColumn = 0 Then
          If UBound(AllHeaders) = 0 Then ReDim AllHeaders(1 To UBound(AllHeaders) + 1) Else ReDim Preserve AllHeaders(1 To UBound(AllHeaders) + 1)
          AllHeaders(UBound(AllHeaders)) = cll.Value
          HeaderColumn = UBound(AllHeaders)
          NewHeader = True
        End If
        If NewHeader Then DestSheet.Cells(1, HeaderColumn).Value = AllHeaders(HeaderColumn)
        cll.Offset(1).Resize(rowscount).Copy DestRow.Offset(, HeaderColumn - 1)
      Next cll
      Set DestRow = DestRow.Offset(rowscount)
      
    End If
      
    Next sht
    WkBk.Close False
  Next fName
End If
End Sub

 

[rlv01]

The code looks ok; but it has certain expectations about what it is going to find in the workbooks you select. For example, it expects to find a worksheet "Final" in every workbook. If that sheet were missing, the code would run but not do anything.

Use the debugger to set some breakpoints after every 'If' statement. Or else single step through the code. That should help you understand where things are going off the rails.