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

Natman111

New Member
Joined
Apr 26, 2021
Messages
14
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Jun 29, 2014
Messages
1,079
Hello Natman,

The following codes will do the task for you:-

VBA 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.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

VBA Code:
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:-

VBA 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.
 
Last edited:

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

vcoolio

Well-known Member
Joined
Jun 29, 2014
Messages
1,079
Hello Natman,

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

VBA 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

New Member
Joined
Apr 26, 2021
Messages
14
Office Version
  1. 365
Platform
  1. Windows
Hello Natman,

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

VBA 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

Well-known Member
Joined
Jun 29, 2014
Messages
1,079
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:-

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

to

VBA Code:
.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:-

VBA Code:
Application.CutCopyMode = False

directly above this line

VBA Code:
Application.ScreenUpdating = True


Cheerio,
vcoolio.
 

Natman111

New Member
Joined
Apr 26, 2021
Messages
14
Office Version
  1. 365
Platform
  1. Windows
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:-

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

to

VBA Code:
.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:-

VBA Code:
Application.CutCopyMode = False

directly above this line

VBA Code:
Application.ScreenUpdating = True


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

vcoolio

Well-known Member
Joined
Jun 29, 2014
Messages
1,079
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:


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

Cheerio,
vcoolio.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,472
Messages
5,636,516
Members
416,922
Latest member
defectexpress

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
Top