Macro to copy rows from multiple sheets with a criteria to another sheet

mali2028 · Aug 16th 2016

Hi all
Can I request your expertise to solve a macro problem.

The attached workbook has got 6 sheets.
Sheet 1 is 'Home'
Sheet 2 is 'A'
Sheet 3 is 'B'
Sheet 4 is 'C'
Sheet 5 is 'D';and
Sheet 6 is 'Consolidated Action Sheet'

Some of the rows in Column F in each sheet has got a text 'Action Item'

I would like to have a macro which helps me to collate all the rows from each sheet with the text 'Action Item' in to the 'Consolidated Action Sheet'

Would be delighted if you can incorporate a step that auto update the Consolidated Action Sheet' when ever data are changed in the relevant sheets

I have tried different options to do this job and you can see my different macros in each sheet.

I am using 2010 excel.

Looking forward for your replies

Thanks guys

**Trebor76** · Aug 17th 2016

Re: Macro to copy rows from multiple sheeets with a criteria to another sheet

Hi mali2028,

Welcome to Ozgrid!!

Though I would just have a single tab with an extra field for the person name which could then simply be filtered to get the required data, this event macro on the sheet to consolidate the data will do what you're after:

Code

Option Explicit


Private Sub Worksheet_Activate()
    Dim lngLastRow  As Long
    Dim lngMyRow    As Long
    Dim lngPasteRow As Long
    Dim wsMySheet   As Worksheet


    Application.ScreenUpdating = False


    'Clear existing data or else the data will continously be appending
    lngLastRow = Range("B:O").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If lngLastRow >= 7 Then
        Range("B7:O" & lngLastRow).ClearContents
    End If


    'Copy in each row where the test in Col. F is 'Action Item'
    For Each wsMySheet In ThisWorkbook.Sheets
        If wsMySheet.Name <> ActiveSheet.Name Then
            On Error Resume Next 'Account for there being no data on the tabs
                lngLastRow = wsMySheet.Range("B:O").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                If lngLastRow >= 7 Then
                    For lngMyRow = 7 To lngLastRow
                        If StrConv(wsMySheet.Range("F" & lngMyRow), vbProperCase) = "Action Item" Then
                            lngPasteRow = Range("B:O").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                            If lngPasteRow < 7 Then lngPasteRow = 7
                            wsMySheet.Range("B" & lngMyRow & ":O" & lngMyRow).Copy Destination:=Range("B" & lngPasteRow)
                        End If
                    Next lngMyRow
                End If
            On Error GoTo 0 'Nullify error message suppression
        End If
    Next wsMySheet


    Application.ScreenUpdating = True


End Sub

Display More

Regards,

Robert

mali2028 · Aug 17th 2016

Re: Macro to copy rows from multiple sheeets with a criteria to another sheet

Excellent Robert.Thank you so much.It works perfectly. I have done the necessary changes to copy the client names from each tab and its working perfect.

Thanks again.

**Trebor76** · Aug 17th 2016

Re: Macro to copy rows from multiple sheeets with a criteria to another sheet

Thanks for letting us know and you're welcome

mali2028 · Aug 18th 2016

Re: Macro to copy rows from multiple sheeets with a criteria to another sheet

Sorry to bother Robert(Trebor76)

I have started inputting data in to the columns in each sheets and I just found an error in the final action. Each time data is amended in the parent sheets, same number of copied rows are pasted back on to the consolidated sheet. That means If there are 74 copied rows in the consolidated sheet, and when I amend the data in one of the sheets, instead of amending the relevant cell in the consolidated sheet, the whole number of rows(74) are again copied and pasted in to the consolidated sheet. the end result is instaed of 74 rows there are now 148 rows.The newly copied cells are blank though

Hope you can help.

**Trebor76** · Aug 18th 2016

Re: Macro to copy rows from multiple sheeets with a criteria to another sheet

Not sure what's happening as the code I wrote under the heading "Clear existing data or else the data will continously be appending" is supposed to deal specifically with that issue :confused:

mali2028 · Aug 19th 2016

Re: Macro to copy rows from multiple sheeets with a criteria to another sheet

My apologies Trebor76. The trouble was due to the changes I made to the sheets to include the client name in the consolidated sheet. I managed to fix the issue and everything is working fine.

Thanks again for the help and my apologies for the trouble

**Trebor76** · Aug 19th 2016

Re: Macro to copy rows from multiple sheets with a criteria to another sheet

No problem. I'm glad you got it all sorted

Macro to copy rows from multiple sheets with a criteria to another sheet

Participate now!

Share

Users Viewing This Thread