Namen aller geöffneten .XLS in VBA Array speichern

Sub Makro1()
Dim iCount As Integer
Dim kCount As Integer
Dim aktiveXLS As Workbook
Dim aktivesFenster(5000) As String
For Each aktiveXLS In Application.Workbooks
For iCount = 0 To Application.Workbooks.Count
aktivesFenster(iCount) = aktiveXLS.Name
iCount = iCount + 1
Next
Next
For kCount = 1 To Application.Workbooks.Count
Windows(aktivesFenster(kCount)).Activate
Range("A3:F3").Select
Selection.Copy
Windows("Basis Auswertung.xlsm").Activate
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
kCount = kCount + 1
Next
End Sub