Copy rows from one sheet to another based on text in one cell.

[Natman111]

I have a spreadsheet with multiple worksheets. I would like to automatically copy rows that are based on a criteria in Column A in all worksheets and then paste in one "Master" Sheet, then repeat for another criteria. Eg. I have 5 sheets, and in Column A in each I am wanting to find the text "MD2" then copy and paste the entire row into "Master" Sheet (on the next available row) - there could be 10 rows per sheet that could met this criteria. Then once this criteria has been completed repeat however this time look for the text "BM2". Hopefully that makes sense. Thank you in advance.

 

[vcoolio]

Hello Natman,

The following codes will do the task for you:-

Option Explicit
Sub Test()

        Dim ws As Worksheet, wsM As Worksheet
        Dim sVal As String
        Set wsM = Sheets("Master")
        Set ws = Sheets(ActiveCell.Value)
        sVal = ActiveCell.Offset(, 5).Value
       
Application.ScreenUpdating = False
       
        wsM.[B12].CurrentRegion.Offset(1).Clear

        With ws.[A13].CurrentRegion
                .AutoFilter 1, sVal
                .Offset(1).Copy wsM.Range("B" & Rows.Count).End(3)(2)
                .AutoFilter
        End With

Application.ScreenUpdating = True

End Sub

and

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("M2:M7,X2:X7")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub

Test

End Sub

As I mentioned in an earlier post, merged cells create major problems for VBA codes and with the plethora of merged cells in the Master sheet, the only way I could get this to work was to un-merge the cells in the Master sheet.
I have attached your sample with the above codes implemented and showing the "un-merged" status of the Master sheet. You'll note that the codes do the task but your columns may no longer align as you had them previously nor would the totals be in their correct columns. You will need to re-format the Master sheet without using merged cells.

With the above codes, the "Test" sub needs to be placed in a standard module and the Worksheet_Change event code needs to be placed into the Master sheet module. For the worksheet_Change event code, do this:-
- Right click on the Master sheet tab.
- Select "View Code" from the menu that appears.
- In the big white code field that then appears, paste the above Worksheet_Change event code.
Each time you make a selection from the source sheet name drop downs (M2:M7 and X2:X7), the relevant data will be immediately transferred to the Master sheet from the selected source sheet. No button is required.

Your sample worksheet is here.

Cheerio,
vcoolio.

P.S. If you do not want the Master sheet to clear with every data transfer and instead prefer to use your "Clear Sheet" button then remove this line from the code:-

wsM.[B12].CurrentRegion.Offset(1).Clear

Alternatively, just place an apostrophe(') in front of the line of code allowing you to keep the line of code but simply de-activating it.

 

[vcoolio]

Hello Natman,

Just a thought on using the MergeArea property in the code:-

Option Explicit
Sub Test()

        Dim ws As Worksheet, wsM As Worksheet
        Dim sVal As String
        Set wsM = Sheets("Master")
        Set ws = Sheets(ActiveCell.Value)
        sVal = ActiveCell.MergeArea.Offset(, 1) '---->MergeArea Property
       
Application.ScreenUpdating = False
       
        wsM.[B12].CurrentRegion.Offset(1).Clear

        With ws.[A13].CurrentRegion
                .AutoFilter 1, sVal
                .Offset(1).Copy wsM.Range("B" & Rows.Count).End(3)(2)
                .AutoFilter
        End With

Application.ScreenUpdating = True

End Sub

I haven't tested it but it just may save you having to re-format the Master sheet. Place the codes into their respective modules as per my last post.

Let us know if this works for you.

Cheerio,
vcoolio.

 

[Natman111]

Hello Natman,

Just a thought on using the MergeArea property in the code:-

Option Explicit
Sub Test()

        Dim ws As Worksheet, wsM As Worksheet
        Dim sVal As String
        Set wsM = Sheets("Master")
        Set ws = Sheets(ActiveCell.Value)
        sVal = ActiveCell.MergeArea.Offset(, 1) '---->MergeArea Property
      
Application.ScreenUpdating = False
      
        wsM.[B12].CurrentRegion.Offset(1).Clear

        With ws.[A13].CurrentRegion
                .AutoFilter 1, sVal
                .Offset(1).Copy wsM.Range("B" & Rows.Count).End(3)(2)
                .AutoFilter
        End With

Application.ScreenUpdating = True

End Sub

I haven't tested it but it just may save you having to re-format the Master sheet. Place the codes into their respective modules as per my last post.

Let us know if this works for you.

Cheerio,
vcoolio.

Hi Vcoolio - wow this works great. Thank you for your help. I have been using it and have see that it is not pulling through the formula's ? is this because of the way it pastes

 

[vcoolio]

Hello Natman,

Normally the standard copy/paste line of code as in the code supplied would do that, however, to ensure that the formulae are transferred over as well, change this line of code:-

.Offset(1).Copy wsM.Range("B" & Rows.Count).End(3)(2)

to

.Offset(1).Copy
wsM.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll

Copy/paste it as you see it (in two lines).

Also, add this line:-

Application.CutCopyMode = False

directly above this line

Application.ScreenUpdating = True

Cheerio,
vcoolio.

 

[Natman111]

Hello Natman,

Normally the standard copy/paste line of code as in the code supplied would do that, however, to ensure that the formulae are transferred over as well, change this line of code:-

.Offset(1).Copy wsM.Range("B" & Rows.Count).End(3)(2)

to

.Offset(1).Copy
wsM.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll

Copy/paste it as you see it (in two lines).

Also, add this line:-

Application.CutCopyMode = False

directly above this line

Application.ScreenUpdating = True

Cheerio,
vcoolio.

Thank you so must this works so well. Thanks for your time on this

 

[vcoolio]

You're welcome Natman. I'm glad to have been able to help.

If the code using the MergeArea Property begins to play up, I'd suggest going back to plan "A" (re-formatting).

You may be interested in this article,"sin" #4 in particular:

The Seven Deadly Sins of Data Entry (or how NOT to use Excel) - Data Management Chicago | DataScopic

When you're creating and using a spreadsheet, avoid these 7 Deadly Sins of Data Entry.

datascopic.net

It'll give you an idea as to why programmers across the Galaxy despise merged cells.

Cheerio,
vcoolio.