Hjælp til fejl på VBA kode

Hej eksperter

Jeg har haft en kollega til at skrive en VBA kode til mig, som kan kopiere et defineret område med data fra en masse ens filer og indsætte dem i en ny fil, så jeg får én lang datatabel med data fra ca 50 filer.

Jeg har brugt koden i Excel 2007. Jeg har nu opgraderet til Excel 2010 og ligepludselig kan jeg ikke kører koden. Jeg får fejl 400!

Koden er som følger og fejlen opstår efter at jeg har valgt hvilken mappe  som filerne med dataene er i:

Sub hentdata()
Call openall
Call sletoverskrifter
End Sub


Sub openall()
'On Error Resume Next
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
getfolder = sItem
Set fldr = Nothing
    Dim strFileName As String
    strFileName = Dir(getfolder & "\*.xls*")
    Do
        If Len(strFileName) <> 0 And strFileName <> ThisWorkbook.Name Then
            Workbooks.Open strFileName, False
           
       
        openwkb = Workbooks(strFileName).Name 'ActiveWorkbook.Name

        'DO YOUR CODE HERE
        For Each sht In Workbooks(openwkb).Worksheets
        For Each cell In ThisWorkbook.Worksheets("CONSOLIDATE DATA").Range("A2:A100")
                    If cell.Value = "" Then Exit For
                    If sht.Name = cell.Value Then
                        a = cell.Offset(0, 1).Text
                        Workbooks(openwkb).Sheets(sht.Name).Range(a).Copy
                        endrow = ThisWorkbook.Sheets(sht.Name).Range("A65000").End(xlUp).Row
                        If endrow = 1 Then endrow = 0
                        ThisWorkbook.Sheets(sht.Name).Cells(endrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        Application.CutCopyMode = False
                    End If
        Next cell
        Next sht
       
        Workbooks(openwkb).Close
       
       
    End If
    strFileName = Dir
    Loop Until Len(strFileName) = 0
ending:
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
.Calculate
.Calculation = xlCalculationAutomatic
End With

End Sub


Sub sletoverskrifter()
For Each sht In ThisWorkbook.Worksheets
For Each cell In ThisWorkbook.Worksheets("CONSOLIDATE DATA").Range("A2:A" & ThisWorkbook.Sheets("CONSOLIDATE DATA").Range("A65000").End(xlUp).Row)
a = sht.Name
If cell.Value = sht.Name Then
endrow = ThisWorkbook.Sheets(sht.Name).Range("A65000").End(xlUp).Row
Set myrng = ThisWorkbook.Worksheets(sht.Name).Range("A2:A" & endrow)
myStrings = "Cost center"

'myrng.Select
With myrng

                Do
                    Set FoundCell = myrng.Find(What:=myStrings, _
                                              After:=.Cells(.Cells.Count), _
                                              LookIn:=xlFormulas, _
                                              LookAt:=xlPart, _
                                              SearchOrder:=xlByRows, _
                                              SearchDirection:=xlNext, _
                                              MatchCase:=False)
                    'Use xlPart If you want to search in a part of the FoundCell
                    'If you use LookIn:=xlValues it will also delete rows with a
                    'formula that evaluates to "Ron"
                    If FoundCell Is Nothing Then
                        Exit Do
                    Else
                        FoundCell.EntireRow.Delete
                    End If
                Loop

        End With

End If
Next cell
Next sht
End Sub

Er der nogen der han løse mit problem så jeg igen kan komme til at bruge min VBA?

Mvh
Line