Macro om cellwaarden te copy pasten (variabel)

[postal]

Hallo,

Ik heb een workbook met vele sheets waarvan 'Index' de hoofdsheet is. Daar in staan in de kolommen B, G en L 20 titels van de sheets die niet altijd het zelfde blijven.
Achter die titels wil ik graag 2 tellers hebben die de waarde van 2 cellen van die desbetreffende sheet halen uit de cellen P1 en Q1.

Ik heb hiervoor de volgende code geschreven die eerst half werkte, maar nu helemaal niet meer Ik ben een beginner met VBA en het lukt me maar niet om verder te komen. Heeft iemand misschien een tip waarmee ik verder kan?

Sub Test()

Dim LastRow As Integer
Dim A

LastRow = ActiveSheet.UsedRange.Rows.Count

A = 3

    For Each cell In Range("B4:B" & LastRow)

        SheetName = cell.Offset(0, 0).Value

        A = A + 1
            Range("C" & A).Value = Sheets(SheetName).Range("P1")
            Range("D" & A).Value = Sheets(SheetName).Range("Q1")
            
    On Error Resume Next
    Next

End Sub

PS, deze code heb ik als test geschreven alleen voor de kolom B. De error message die ik nu ontvang is dat het subscript buiten het bereik valt.

Gr,
Dennis

 

[snb]

Het zou handiger zijn als je in cel B3 geen punt had staan.
Nog handiger wordt het als je geen getal gebruikt als naam voor een werkblad.
Dan werkt deze code

Sub Test()
  For Each cl In Sheets("Index").Columns(2).SpecialCells(xlCellTypeConstants)
    cl.Offset(, 1).Resize(, 2) = Sheets(cl.Value).Range("P1:Q1").Value
  Next
End Sub

Als je ook getallen als werkbladnamen gebruikt:

Sub Test()
  For Each cl In Sheets("Index").Columns(2).SpecialCells(xlCellTypeConstants)
    cl.Offset(, 1).Resize(, 2) = Sheets(Format(cl.Value)).Range("P1:Q1").Value
  Next
End Sub

of

Sub Test()
  For Each cl In Sheets("Index").Columns(2).SpecialCells(xlCellTypeConstants)
    cl.Offset(, 1).Resize(, 2) = Sheets(cl.Text).Range("P1:Q1").Value
  Next
End Sub

 

[postal]

Geweldig bedankt voor je snelle en prachtige oplossing Ik heb nog veel te leren merk ik al weer.
Maar ik wil niet als ondankbaar overkomen maar ik heb in cel G1 en L1 dingen staan die daar moeten blijven voor de layout. Aangezien de titels ook in die kolommen komen te staan krijg ik weer dezelfde foutmelding omdat die natuurlijk niet bestaan.

Is er geen manier om die "Columns2" van rij 4 te kunnen laten beginnen? Want in Rij 4 beginnen de titels pas.

Alsnog hartelijk bedankt voor je antwoord, als dit niet makkelijk uitvoerbaar is moet ik maar eens kijken of ik de lay out kan aanpassen om deze code heen.

Gr,
Dennis