Positioning multiple shapes based on cell values

I'm looking for help with positioning multiple shapes based values which are stored in cell references.
My current code positions them individually, but if possible, I would like to create a loop to simplify the solution

Sheet 2 contains the cell reference for positioning & size
Sheet 4 contains the actual shape.

Sub PrjTasks()
 
    With ActiveSheet.Shapes.Range(Array("Task1_01"))
        .Left = Range(Sheet2.Range("AQ2").Value).Left
        .Top = Range(Sheet2.Range("AQ2").Value).Top + (Range(Sheet2.Range("AQ2").Value).Height - 11) / 2
        .Width = Sheet2.Range("AG2").Value
        .Height = 11
    End With

    With ActiveSheet.Shapes.Range(Array("Task2_01"))
        .Left = Range(Sheet2.Range("AR2").Value).Left
        .Top = Range(Sheet2.Range("AR2").Value).Top + (Range(Sheet2.Range("AR2").Value).Height - 11) / 2
        .Width = Sheet2.Range("AH2").Value
        .Height = 11
    End With

    With ActiveSheet.Shapes.Range(Array("Task3_01"))
        .Left = Range(Sheet2.Range("AS2").Value).Left
        .Top = Range(Sheet2.Range("AS2").Value).Top + (Range(Sheet2.Range("AS2").Value).Height - 11) / 2
        .Width = Sheet2.Range("AI2").Value
        .Height = 11
    End With

    With ActiveSheet.Shapes.Range(Array("Task1_02"))
        .Left = Range(Sheet2.Range("AQ3").Value).Left
        .Top = Range(Sheet2.Range("AQ3").Value).Top + (Range(Sheet2.Range("AQ3").Value).Height - 11) / 2
        .Width = Sheet2.Range("AG3").Value
        .Height = 11
    End With

    With ActiveSheet.Shapes.Range(Array("Task2_02"))
        .Left = Range(Sheet2.Range("AR3").Value).Left
        .Top = Range(Sheet2.Range("AR3").Value).Top + (Range(Sheet2.Range("AR3").Value).Height - 11) / 2
        .Width = Sheet2.Range("AH3").Value
        .Height = 11
    End With

    With ActiveSheet.Shapes.Range(Array("Task3_02"))
        .Left = Range(Sheet2.Range("AS3").Value).Left
        .Top = Range(Sheet2.Range("AS3").Value).Top + (Range(Sheet2.Range("AS3").Value).Height - 11) / 2
        .Width = Sheet2.Range("AI3").Value
        .Height = 11
    End With
End Sub

Thanks for taking time to look at this

Sub PrjTasks_1()

    Dim Sh2         As Worksheet
    Dim Sh4         As Worksheet
    Dim r           As Long
    Dim c           As Long
    Dim rng         As Range

    Set Sh2 = Sheet2
    Set Sh4 = Sheet4

    For r = 1 To 2
        For c = 1 To 3

            With Sh4.Shapes("Task" & c & "_" & Format(r, "00"))
                Set rng = Sh4.Range(Sh2.Range("AP1").Offset(r, c).Value)
                .Left = rng.Left
                .Top = rng.Top + (rng.Height - 11) / 2
                .Width = Sh4.Range(Sh2.Range("AF1").Offset(r, c).Value).Width
                .Height = 11
            End With

        Next c
    Next r

End Sub

Artik

Thanks Artik, however

Width = Sh4.Range(Sh2.Range("AF1").Offset(r, c).Value).Width

is returning runtime error 1004

If I have something to test the code on, I will tell you what the problem is. I don't know what it looks like with you and I will not guess.

Artik

Hi Artik, here is a version of my file. Thank you

Oops. Instead of

.Width = Sh4.Range(Sh2.Range("AF1").Offset(r, c).Value).Width

it should be

.Width = Sh2.Range("AF1").Offset(r, c).Value

Artik

Many thanks Artik, everything is working perfectly now