2 Spalten aus Datei auslesen

Private Sub CommandButton3_Click()
Dim strFile As String, strSheet As String, strDate As String
Dim dDate As Date
Dim varValues As Variant
Dim objFSO As Object
Dim rngFind As Range, rng As Range
Dim lngR As Long, lngLast As Long, lngNew As Long
'Datei öffnen
strFile = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlt; *.xla)," & _
"*.xls; *.xlt; *.xla")
If strFile = "Falsch" Then Exit Sub
Set objFSO = CreateObject("Scripting.FileSystemObject")
strDate = objFSO.GetBaseName(strFile)
'Spalten kopieren (Monate)
Columns("I:M").Copy Destination:=Columns("H:H")
dDate = DateValue("01/" & Replace(strDate, "_", " "))
Sheets("Termintreue").Range("M2").Value = dDate
'Sheets("Termintreue").Range("M2") = Format(Range("M2"), "MMMM YYYY")
strSheet = "Tabelle1"
With ExcelTable(strFile, strSheet, "A1:D65536")
varValues = .GetRows
.Close
End With
'Daten von Datei in die entsprechende Spalte passend zur entsprechenden Zeile einfügen
With Sheets("Termintreue")
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row
lngNew = lngLast + 1
Set rngFind = .Rows(2).Find(dDate)
If Not rngFind Is Nothing Then
For lngR = 0 To UBound(varValues, 2)
Set rng = .Range(.Cells(4, 2), .Cells(lngLast, 2)).Find(varValues(1, lngR), lookat:=xlWhole)
If Not rng Is Nothing Then
.Cells(rng.Row, rngFind.Column) = varValues(2, lngR)
Else
If Left(UCase(varValues(1, lngR)), 1) Like "[A-L]" Then
.Cells(lngNew, 1) = varValues(0, lngR)
.Cells(lngNew, 2) = varValues(1, lngR)
.Cells(lngNew, rngFind.Column) = varValues(2, lngR)
lngNew = lngNew + 1
End If
End If
Next
End If
'Zeilen dem Alphabet nach sortieren
.Range(.Cells(2, 1), .Cells(lngNew, .Cells(2, Columns.Count).End(xlToLeft).Column)).Sort _
Key1:=Range("B3"), _
Order1:=xlAscending, _
Header:=xlYes
End With
Set objFSO = Nothing
Set rngFind = Nothing
End Sub