Cleancode oder DB einfach zu groß?

Sub lala()
Sheets(1).Select
Sheets(1).Cells.Clear
Dim b As Integer
For b = 3 To 565
Sheets(b).Select
Range("A1:H30000").Select
Selection.ClearContents
Next b
Sheets(1).Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\xxx\Desktop\test.csv", Destination:=Range( _
"$A$1"))
.Name = "Nichts verändern"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'Columns("A:A").Select
'Range("A9999").Activate
'Selection.NumberFormat = "dd.mm.yyyy"
'Columns("B:B").Select
'Range("B9999").Activate
'Selection.NumberFormat = "@"
' Columns("C:C").Select
' Range("C9999").Activate
'Selection.NumberFormat = "@"
'Columns("D:D").Select
' Range("D9999").Activate
'Selection.NumberFormat = "@"
' Columns("E:E").Select
' Range("E9999").Activate
'Selection.NumberFormat = "@"
' Columns("F:F").Select
' Range("F9999").Activate
' Selection.NumberFormat = "@"
'Columns("G:G").Select
' Range("G9999").Activate
'Selection.NumberFormat = "@"
Sheets(2).Select
Call Makro1
Sheets(2).Select
End Sub
Sub Makro1()
Dim a As Integer
For a = 3 To 565
Sheets(a).Select
Call aaa
Range("H2").Select
ActiveCell.Value = WorksheetFunction.Sum(Columns(7))
Next a
End Sub
Sub aaa()
Dim oDaten As Variant, arrTmp As Variant
Dim arrDaten() As Variant
Dim i As Long, J As Integer, n As Long
Dim arrItems As Variant
Dim x As Long
Dim mysht As Variant
mysht = ActiveSheet.Range("I1")
Sheets(1).Cells(1, 9) = mysht
Set oDaten = CreateObject("scripting.Dictionary")
arrTmp = Sheets(1).Cells(1, 1).CurrentRegion
oDaten(1) = WorksheetFunction.Index(arrTmp, 1)
For x = 1 To 7 'durchläuft Spalte 1-7
For i = 2 To UBound(arrTmp)
If arrTmp(i, x) = Sheets(1).Cells(1, 9) Then
oDaten(i) = WorksheetFunction.Index(arrTmp, i)
End If
Next i
Next x
ReDim arrDaten(1 To oDaten.Count, 1 To 7)
arrItems = oDaten.items
For i = 0 To UBound(arrItems)
n = n + 1
For J = 1 To 7
arrDaten(n, J) = arrItems(i)(J)
Next
Next
With ActiveSheet 'Sheets(mysht)
.Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 7).ClearContents
.Cells(1, 1).Resize(UBound(arrDaten), 7) = arrDaten
End With
End Sub