VBA - xls-Dateien einlesen - nochmals Codeergänzun

Option Explicit
Sub Import_XLS()
Dim arrStrings(3, 1) As Variant
Dim Intc As Integer
Dim strPath As String
Dim strFile As String
Dim strTab As String
Dim lngI As Long
' Sheets("Infofenster").Select
Application.ScreenUpdating = False
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
.Cursor = xlWait
End With
Sheets("A_Xls_Export").Range("A:BZ").ClearContents
Sheets("B_Xls_Export").Range("A:BZ").ClearContents
Sheets("C_Xls_Export").Range("A:BZ").ClearContents
Sheets("D_Xls_Export").Range("A:BZ").ClearContents
arrStrings(0, 0) = "A_Xls_Export"
arrStrings(0, 1) = "A_Xls_Export.xls"
arrStrings(1, 0) = "B_Xls_Export"
arrStrings(1, 1) = "B_Xls_Export.xls"
arrStrings(2, 0) = "C_Xls_Export"
arrStrings(2, 1) = "C_Xls_Export.xls"
arrStrings(3, 0) = "D_Xls_Export"
arrStrings(3, 1) = "D_Xls_Export.xls"
For Intc = 0 To UBound(arrStrings)
Sheets(arrStrings(Intc, 0)).Range("A1:IV65536").ClearContents
Dim IntcPfad As String
Dim IntcDateiname As String
Dim IntcBlatt As String
Dim IntcZellen As String
Dim wsTemp As Worksheet
Set wsTemp = ActiveWorkbook.Worksheets.Add(After:=ActiveWorkbook.Worksheets( _
ActiveWorkbook.Worksheets.Count))
wsTemp.Name = "TemporäresBlatt"
IntcPfad = "D:\___XLS_EXPORTE\" 'Datenarbeitsmappe
IntcDateiname = arrStrings(Intc, 1)
IntcBlatt = "Sheet0"
Dim objADO As Object
Dim strFileGesamt As String, strRef2 As String
strFileGesamt = IntcPfad & IntcDateiname
strRef2 = "Sheet0$A:Z" 'normale Bereichsangabe unbedingt MIT Tabellenname & $-Zeichen
Set objADO = ExcelTable(strFileGesamt, strRef2)
'Spaltennamen!
For lngI = 1 To objADO.Fields.Count
wsTemp.Cells(1, lngI) = Replace(objADO.Fields(lngI - 1).Name, "#", ".")
Next
wsTemp.Range("A2").CopyFromRecordset objADO
objADO.Close
If wsTemp.Range("F1") = "MitgliedNEU" Then
wsTemp.Columns("F:G").Delete
End If
If wsTemp.Range("H1") = "Adresse2" Then
wsTemp.Columns("H:H").Delete
End If
wsTemp.Columns("A:Z").Copy
Worksheets(arrStrings(Intc, 0)).Range("A1").PasteSpecial (xlPasteAll)
wsTemp.Delete
Next
With Application
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.Cursor = xlDefault
End With
End Sub