Extracting records into a Summary worksheet


New Member
Mar 4, 2009
I need a little help please.

I have 12 worksheets ( January through December ). Each worksheet is made up of 7 columns ( a record of 7 fields) the last column has the entry of either "Yes" or "No". I am having difficulty creating a macro that will go to each worksheet ( month) and return the records that have a "No" in the last column to my summary page. Can anyone help?

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.


Well-known Member
Jul 23, 2007
Hi Jackster,

Welcome to the forum.

Run the following ConsDataByMonth macro on whatever tab (you'll be asked to confirm) you want the data to be consolidated on. Just note that the code assumes the data starts at row 2 on each sheet:

Sub ConsDataByMonth()

    'Confirm the active tab is where the data is to consolidated.
    If MsgBox("Please click ""Yes"" if the data is to be consolidated on the " _
              & ActiveSheet.Name & " tab.", _
              vbYesNo + vbExclamation, "Data Consolidation Editor") = vbNo Then
        MsgBox "Select the tab you wish to have the data consolidated on and try again." _
            , vbInformation, "Data Consolidation Editor"
    Exit Sub
    End If
    Application.ScreenUpdating = False

    'Remove any existing filters
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If

    'Declare variables
    Dim lngLastRow As Long
    Dim wSheet As Worksheet
    Dim rCopy, rPaste As Range
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    If lngLastRow > 1 Then
        ActiveSheet.Range("A2:G" & lngLastRow).ClearContents
    End If
    For Each wSheet In Worksheets
        If wSheet.Name <> ActiveSheet.Name Then
            With wSheet
                Set rCopy = .Range("A2", .Cells(Rows.Count, "G").End(xlUp))
            End With
            Set rPaste = ActiveSheet.Cells(Rows.Count, "A").End(xlUp)(2, 1)
            rPaste.PasteSpecial Paste:=xlValues, Paste:=xlPasteFormats
            Application.CutCopyMode = False
        End If
    Next wSheet

    With ActiveSheet
        'Set the autofilter
        'Hide all rows that are NOT to be deleted
        .Columns("G").AutoFilter Field:=7, Criteria1:="Yes"
        .Rows("1").EntireRow.Hidden = True
        'Delete all visible data rows in Column G
        'Remove filter from A1:G1
        .AutoFilterMode = False
        'Unhide Row 1.
        .Rows("1").EntireRow.Hidden = False
        'Autofit the dataset
    End With

    Application.ScreenUpdating = True


End Sub


Upvote 0


New Member
Feb 10, 2009
Well, I guess I am a little late on this one.. but,

Sub Summery()
Dim ws As Worksheet, cel As Range, SumSheet As String
SumSheet = "Sheet1" '****** Change "Sheet1" to name of your summery sheet******
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
    If Not ws.Name = SumSheet Then
        For Each cel In Range("G:G")
            If cel.Value Like "Yes" Or cel.Value Like "yes" Then
                  Call CopyRow(cel.row, ws.Name, SumSheet)
            End If
    End If
Application.ScreenUpdating = True
End Sub

Sub CopyRow(r As Integer, CurSheet As String, SumSheet As String)
Dim c As Object
    On Error Resume Next
    With Sheets(SumSheet).Range("A:A")
     Set c = .Find(What:="*", LookIn:=xlValues, Lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious)
    End With
    Worksheets(CurSheet).Rows(r).Copy Destination:=Worksheets(SumSheet).Rows(c.row + 1)
End Sub

May be a lil rough... Good luck though
Upvote 0

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back