Probleem met deel van code om sheet te selecteren in "IF" formulering

[TempoWillem]

Hallo allemaal,

Met alle hulp en tips in mijn andere vragen heb ik een hoop voor elkaar gekregen. Daardoor werd mij een nieuwe vraag gesteld en bij het oplossen daarvan loop ik tegen een probleempje aan.

Ik heb twee bestanden. Het ene, ik noem het maar "Bronbestand", wordt extern periodiek aangeleverd en bevat voor iedere week een werkblad met de naam "wk(weeknummer)". Op die bladen staan in bepaalde cellen waardes die ik naar een ander bestand ("Data") moet halen om verder te verwerken.
Op zich lukt dat dankzij code die ik al eerder hier bij elkaar heb kunnen sprokkelen. Er moet echter een omvorming bij zitten van de naam van het werkblad naar een cel, zodat ik die waarde weer in de tabel kan plaatsen. Daar heb ik code voor gevonden die werkt, maar wat me niet lukt is om de code eerst de betreffende sheet te laten selecteren, om vervolgens de bladnaam in een cel te plaatsen.

Dit is mijn code:

Sub Import_data()
Application.ScreenUpdating = False
Sheets("Vulblad").Range("A2:B54").ClearContents
Workbooks("Bronbestand.xlsx").Activate
For Each sh In Sheets
    If Left(sh.Name, 2) = "wk" Then
        Sheets(sh).Range("E1").Select
        ActiveCell.FormulaR1C1 = _
        "=RIGHT(CELL(""bestandsnaam"",R[-5]C[-13]),LEN(CELL(""bestandsnaam"",R[-5]C[-13]))-SEARCH(""]"",CELL(""bestandsnaam"",R[-5]C[-13]),1))"
        With Workbooks(Data.xlsb).Sheets("Vulblad")
            .Cells(.Columns(1).SpecialCells(2).Count, 1).Offset(1).Resize(, 2) = Array(sh.[E1], sh.[A1])
        End With
    End If
Next sh
Workbooks(Data.xlsx).Activate
Application.ScreenUpdating = True

End Sub

En dit zijn mijn twee voorbeeldbestanden:
Bekijk bijlage Data.xlsb
Bekijk bijlage Bronbestand.xlsx

Op

Sheets(sh).Range("E1").Select

loop ik steeds vast, ook als ik wat andere variaties probeer.
Wat dus zou moeten gebeuren:
1-Als het werkblad "wk" in de naam heeft,
2-Werkblad selecteren, cel E1 selecteren,
3-Formule in de cel plaatsen,
4-Waardes uit in Array aangegeven cellen (inclusief dus E1) importeren in tabel in "Data"
5-Volgende werkblad.

Nu loop ik dus steeds vast op stap 2...

Wie kan en wil helpen? Bij voorbaat dank!

 

[Timshel]

Die formule halverwege jouw routine plaatst de sheetnaam in cel E1. Dat lijkt me nogal omslachtig. Gebruik gewoon Sh.name:

Sub Import_data()
    Sheets("Vulblad").Range("A2:B54").ClearContents
    With CreateObject("System.Collections.Arraylist")
        For Each sh In Workbooks("Bronbestand.xlsx").Sheets
            If Left(sh.Name, 2) = "wk" Then .Add Array(sh.Name, sh.[A1])
        Next sh
        ThisWorkbook.Sheets("Vulblad").Cells(2, 1).Resize(.Count, 2) = Application.Index(.ToArray, 0)
    End With
End Sub

 

[TempoWillem]

Die formule halverwege jouw routine plaatst de sheetnaam in cel E1. Dat lijkt me nogal omslachtig. Gebruik gewoon Sh.name:

Sub Import_data()
    Sheets("Vulblad").Range("A2:B54").ClearContents
    With CreateObject("System.Collections.Arraylist")
        For Each sh In Workbooks("Bronbestand.xlsx").Sheets
            If Left(sh.Name, 2) = "wk" Then .Add Array(sh.Name, sh.[A1])
        Next sh
        ThisWorkbook.Sheets("Vulblad").Cells(2, 1).Resize(.Count, 2) = Application.Index(.ToArray, 0)
    End With
End Sub

Hoi Timshel,

Dank voor je oplossing.
Van jouw code weet ik echter niet waar ik nog andere cellen uit het echte bronbestand aan de code toe kan voegen zodat ook die meegenomen worden naar "data". Die heb ik voor de eenvoud niet in mijn voorbeelden gezet, omdat ik met mijn eigen code weet hoe ik dat voor elkaar krijg... Ik neem aan dat die er ergens in de regel "Thisworkbook.Sheets" er bij komen...

Hoe wordt die bijvoorbeeld als ik ook nog cellen F14, D25, H38 en J33 wil toevoegen?

 

[Timshel]

Gelieve niet onnodig quoten.
Ik denk zo:

Sub Import_data()
    Sheets("Vulblad").Range("A2:B54").ClearContents
    With CreateObject("System.Collections.Arraylist")
        For Each sh In Workbooks("Bronbestand.xlsx").Sheets
            If Left(sh.Name, 2) = "wk" Then .Add Array(sh.Name, sh.[A1], sh.[F14], sh.[D25], sh.[H38], sh.[J33])
        Next sh
        ThisWorkbook.Sheets("Vulblad").Cells(2, 1).Resize(.Count, [COLOR="#FF0000"]6[/COLOR]) = Application.Index(.ToArray, 0)
    End With
End Sub

 

[TempoWillem]

Ach so! Ga er meteen mee aan de gang. Dank, Timshel!