VBA Daten einlesen mit var. Überschriftenzeile

Public Sub data()
Dim objWB As Workbook, objWS As Worksheet, objWSImport As Worksheet, objOption As Worksheet
Dim objText As Range, objIdentifier As Range
Dim strFile As String
Dim lngLast As Long, lngCol As Long, lngLastCol As Long
Dim varRes As Variant
MsgBox "Bitte zu importierende Datei auswählen!"
strFile = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
"*.xls; *.xlsx; *.xlsm")
If strFile = "Falsch" Then Exit Sub
Set objOption = ThisWorkbook.Sheets("Optionen")
Set objText = ThisWorkbook.Sheets("Optionen").Cells(1, 3)
Set objIdentifier = ThisWorkbook.Sheets("Optionen").Cells(2, 3)
Set objWSImport = ThisWorkbook.Sheets("Daten")
Set objWB = Workbooks.Open(strFile)
If Not SheetExist(objText.Value, objWB.Name) Then
MsgBox "Die ausgewählte Datei enthält kein Sheet mit dem Namen " & objOption.Cells(11, 3). _
Value & "! Der Import wurde abgebrochen."
Else
Set objWS = objWB.Sheets(objText.Value)
End If
With objWSImport
.Range("B3:DC30000").ClearContents
lngLastCol = Application.Max(1, objWS.Cells(objIdentifier.Value, Columns.Count).End(xlToLeft). _
Column)
For lngCol = 1 To lngLastCol
If objWS.Cells(1, lngCol)  "" Then
varRes = Application.Match(objWS.Cells(objIdentifier.Value, lngCol), .Rows(1), 0)
If IsNumeric(varRes) Then
lngLast = objWS.Cells(Rows.Count, lngCol).End(xlUp).Row
objWS.Range(objWS.Cells(objIdentifier.Value + 1, lngCol), objWS.Cells(lngLast, lngCol)). _
Copy
.Cells(3, varRes).PasteSpecial xlValues
End If
End If
Next
End With
MsgBox "Neue Daten importiert!"
End Sub