Extract multiple sheets data into one sheet

Can you use this?

Sub jun22()
Dim x As String
Dim y As String
Dim z As String
Dim rng As Range
Dim i As Long
Dim ws As Worksheet

Set ws = Sheets("monthly")
ws.Activate
x = ws.Cells(1, "C").Value
y = ws.Cells(1, "D").Value
z = ws.Cells(1, "E").Value
For i = 3 To ws.Range("A" & Rows.count).End(3).Row Step 4
    Set rng = Sheets(x).Rows(1).Find(Range("A" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
        If Not rng Is Nothing Then
            Sheets(x).Activate
            Cells(2, rng.Column).Select
            Do Until ActiveCell.Value <> ""
                ActiveCell.offset(1).Select
            Loop
            Range(ActiveCell, ActiveCell.offset(3)).Copy ws.Range("C" & i)
        End If
        Set rng = Nothing
    ws.Activate
    Set rng = Sheets(y).Rows(1).Find(Range("A" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
        If Not rng Is Nothing Then
            Sheets(y).Activate
            Cells(2, rng.Column).Select
            Do Until ActiveCell.Value <> ""
                ActiveCell.offset(1).Select
            Loop
            Range(ActiveCell, ActiveCell.offset(3)).Copy ws.Range("D" & i)
        End If
        Set rng = Nothing
        ws.Activate
    Set rng = Sheets(z).Rows(1).Find(Range("A" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
        If Not rng Is Nothing Then
            Sheets(z).Activate
            Cells(2, rng.Column).Select
            Do Until ActiveCell.Value <> ""
                ActiveCell.offset(1).Select
            Loop
            Range(ActiveCell, ActiveCell.offset(3)).Copy ws.Range("E" & i)
        End If
        Set rng = Nothing
ws.Activate
Next i

End Sub

Hi John,

This great, it does exactly what I require. I have a small issue with the data content, which is, in Aug, June..etc worksheet there values under bs, cm...etc, which , are calculated using 'sum' formula and when I run the code, in the 'monthly' worksheet, the values get extracted as '#Ref'. Is this something easy to fix/or add in the code. Apology for the last minute trouble.

if you require further detailed example, on the above request, please do let me know.

Many thanks for your time.

Try:

Sub jun22()
Dim x As String
Dim y As String
Dim z As String
Dim rng As Range
Dim i As Long
Dim ws As Worksheet

Set ws = Sheets("monthly")
ws.Activate
x = ws.Cells(1, "C").Value
y = ws.Cells(1, "D").Value
z = ws.Cells(1, "E").Value
For i = 3 To ws.Range("A" & Rows.count).End(3).Row Step 4
    Set rng = Sheets(x).Rows(1).Find(Range("A" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
        If Not rng Is Nothing Then
            Sheets(x).Activate
            Cells(2, rng.Column).Select
            Do Until ActiveCell.Value <> ""
                ActiveCell.offset(1).Select
            Loop
            ws.Range(Cells(i, "C"), Cells(i + 3, "C")).Value = Range(ActiveCell, ActiveCell.offset(3)).Value
        End If
        Set rng = Nothing
    ws.Activate
    Set rng = Sheets(y).Rows(1).Find(Range("A" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
        If Not rng Is Nothing Then
            Sheets(y).Activate
            Cells(2, rng.Column).Select
            Do Until ActiveCell.Value <> ""
                ActiveCell.offset(1).Select
            Loop
            ws.Range(Cells(i, "D"), Cells(i + 3, "D")).Value = Range(ActiveCell, ActiveCell.offset(3)).Value
        End If
        Set rng = Nothing
        ws.Activate
    Set rng = Sheets(z).Rows(1).Find(Range("A" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
        If Not rng Is Nothing Then
            Sheets(z).Activate
            Cells(2, rng.Column).Select
            Do Until ActiveCell.Value <> ""
                ActiveCell.offset(1).Select
            Loop
            ws.Range(Cells(i, "D"), Cells(i + 3, "D")).Value = Range(ActiveCell, ActiveCell.offset(3)).Value
        End If
        Set rng = Nothing
ws.Activate
Next i

End Sub