Extract multiple sheets data into one sheet

I would like to request some help, in creating macro which can read data from one/or more sheet and copy and paste it into another sheet, by matching up column A & B and Row 1, between the both sheets.

I have monthly data stored in each sheet, named as May, June, July etc. I also have sheet called 'monthly' within the same workbook, where I would like to extract all monthly totals, from sheets july, June etc, into the 'Monthly' worksheet by matching up its names from Column A and B and row1 header with each sheet's names.

The june,july worksheets have date1, date2 etc, columns with data and after those columns, there are the 'bs, rm, cm, cd, cl' columns, and these are the columns, I would like to use, to extract the numbers from and paste in the 'monthly' worksheet.

My current issue, is that the 'bs, rm, cm..etc' columns are not fixed, due to the 'date1, date2 etc' columns can vary, for each month.

For this current task, I was using a formula as shown below to extract the values into 'monthly' worksheet, however due to unfixed columns for 'bs, rm, cm... etc', I could not get the formula to work for the 'july' and 'Aug' months (i.e. extract data into 'monthly' worksheet, from the june&aug sheets).

=IFERROR(SUMIFS(OFFSET(INDIRECT(C$1 & "!$A$3:$A$21"),0,MATCH($A3,INDIRECT(C$1 & "!$A$1:$G$1"),0)-1),INDIRECT(C$1 & "!$A$3:$A$21"),$A3,INDIRECT(C1 & "!$B$3:$B$21"),$B3),"")

I would like to request, if it is possible to use the formula below to re-create macro which can carry out this task, by extracting all the values from 'june, july, aug etc' sheet, into the 'monthly' sheet, at once.

I have attached a sample workbook with example of data layout and desired output shown in monthly worksheet.
data_extraction2.xls

I hope i have explained my issue clearly, if not, then please free to ask further question, for any clarification.

Thank you, for all your help.

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

Hi John,

Apology for not getting back to you sooner. I am sorry to inform, I was unable to run the updated macro successfully. The updated macro is throwing a "run-time error 1004", when I run it on example workbook file(data_extraction_2). I believe the error is within the first for loop of the code, hence when I run the macro, I get transferred to the 'June' worksheet.

data_extraction3.xlsm
I have attached the same sample data with 'June' sheet showing 'sum formula' values under the 'bs, rm, cm..etc' columns and the rest of the worksheets 'july' & 'aug', have just number values. The macro is attached in the workbook example.

Thank you very much for updating the code in your previous post.

Many thanks for your response and time in solving the issue.

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(ws.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.Cells(i, "C").Resize(3).Value = Range(ActiveCell, ActiveCell.offset(3)).Value
        End If
        Set rng = Nothing
    ws.Activate
    Set rng = Sheets(y).Rows(1).Find(ws.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.Cells(i, "D").Resize(3).Value = Range(ActiveCell, ActiveCell.offset(3)).Value

        End If
        Set rng = Nothing
        ws.Activate
    Set rng = Sheets(z).Rows(1).Find(ws.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.Cells(i, "E").Resize(3).Value = Range(ActiveCell, ActiveCell.offset(3)).Value
        End If
        Set rng = Nothing
ws.Activate
Next i

End Sub

Thank you for your quick response back. The code works great! Many thanks for your hardwork and time into this.

You're welcome. Glad to help out and thanks for the feedback.