Loop imellem filer

Hej

Jeg har fundet en løsning, hvor jeg looper mellem filer med samme sheet-navn, udfører en procedure, og dernæst looper til filerne igen, hvor jeg så har en procedure for næste sheet. Koden kan sikkert skrives smartere, men nedenstående virker ift. formålet.

Sub AFKAST_loop()

    Dim myValue1 As Variant
    myValue1 = InputBox("Indtast årstal (YYYY)")
   
    Dim myValue2 As Variant
    myValue2 = InputBox("Indtast kvartal (DD.MM.YYYY)")

    Windows("FF Kbhx").Activate

    Dim folderPath As String
    Dim filename As String
    Dim wb As Workbook
 
    folderPath = "I:\Ledelse\Management Support\Afkastrapportering\Byg VBA\Test"
   
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
   
   
    filename = Dir(folderPath & "*.xls")
    Do While filename <> ""
 
    Worksheets("dk obl").Activate

    ActiveSheet.Range("B2").Activate
    ActiveCell.Formula = "='I:\Ledelse\Management Support\Afkastrapportering\" &
    myValue1 & "\" & myValue2 & "\" & "[intervaller.xls]Sheet1'!B2"

    Selection.AutoFill Destination:=Range("B2:B11"), Type:=xlFillDefault
   
    Range("B2:B11").Select
    Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "

    ActiveSheet.Range("A1").Activate

    Set wb = Workbooks.Open(folderPath & filename)
       
    filename = Dir
   
    Loop
   
       
    filename = Dir(folderPath & "*.xls")
    Do While filename <> ""

    Worksheets("udl obl").Activate

    ActiveSheet.Range("B2").Activate
    ActiveCell.Formula = "='I:\Ledelse\Management Support\Afkastrapportering\" &
    myValue1 & "\" & myValue2 & "\" & "[intervaller.xls]Sheet1'!E2"

    Selection.AutoFill Destination:=Range("B2:B11"), Type:=xlFillDefault
   
    Range("B2:B11").Select
    Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "

    ActiveSheet.Range("A1").Activate
   
    Worksheets("data").Activate

    Set wb = Workbooks.Open(folderPath & filename)
       
    filename = Dir
   
    Loop

End Sub