Transfer data to another worksheet by name?

NickCraig

New Member
Joined
Jul 18, 2002
Messages
36
Hello
I am trying to write a Makro which transfers data to another worksheet depending on whose name a line relates to e.g.

Master worksheet contains
Col A B C D
Line 1 Andy London 10 250
Line 2 Fred Glasgow 30 90
Line 3 John Bristol 45 78
Line 4 Pete Poole 5 500
Line 5 Andy Southend 50 120

I would then a makro to turn blank worksheet "Andy" into:
Col A B C D
Line 1 Andy London 10 250
Line 2 Andy Southend 50 12

And another makro to turn blank worksheet "Fred" into:

Col A B C D
Line 1 Fred Glasgow 30 90

etc etc

Is this doable, obviously with a lot more data than just this?!
Thanks
Nick
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Here's a way if you have already created a sheet for each person, named eg Andy:

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim Source As Worksheet ' Sheet containing data
    Dim Crit As String
'   *** Change sheet name to suit ***
    Set Source = Worksheets("Sheet1")
    If Sh.Name = Source.Name Then Exit Sub
    Application.ScreenUpdating = False
'   Sheet name is data required
    Crit = ActiveSheet.Name
'   Delete current data
    ActiveSheet.Cells.Clear
    With Source.Range("A1").CurrentRegion
'       Filter for column 1 = sheet name
        .AutoFilter Field:=1, Criteria1:=Crit
'       Copy data to active sheet
        .Copy ActiveSheet.Range("A1")
'       Trn off Autofilter
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

To use the code right click the XL icon to the left of file on the menu and choose View Code. Paste the code into the window on the right. The code assumes that the master list is in Sheet1 - change it if necessary. Press Alt+F11 to return to your workbook.

Now when you activate one of your "names" sheets, the relevant data will be transferred automatically. Please note that the code assumes you have a header row above your list.
 
Upvote 0
Thanks Andrew
This is just what I am after but have not been able to get your macro to work.

Perhaps I have adapted it incorrectly, changes I have made are:
* Put the commands after Worksheet on line 2 onto a new line
* Changed line 4 to ' Andy
* Changed "Sheet1" to "Input" on line 5
* On lines 12 & 16 changed "A1" to "A4" because this is where the data starts.

Have I done something wrong?

Thanks
Nick
 
Upvote 0
Thankyou....

Dim Source As Worksheet
' Sheet containing data
Dim Crit As String
' Andy
Set Source = Worksheets("Andy")
If Sh.name = Source.name Then Exit Sub
Application.ScreenUpdating = False
' Sheet name is data required
Crit = ActiveSheet.name
' Delete current data
ActiveSheet.Cells.Clear
With Source.Range("A4").CurrentRegion
' Filter for column 1 = sheet name
.AutoFilter Field:=1, Criteria1:=Crit
' Copy data to active sheet
.Copy ActiveSheet.Range("A4")
' Trn off Autofilter
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
If your data is on sheet Input, then:

Set Source = Worksheets("Andy")

should be:

Set Source = Worksheets("Input")
 
Upvote 0
Thanks Andrew, I am getting there....

A few little problems, I think because my spreadsheet is a little more complex than the example:

* I actually want the filter to be based on the content of column D in the input sheet and only starting from row 4. I have tried changing your macro wherever there is A1 to D4 but this does not seem to work and also offsets all the columns by 4 in the output sheets.
* My input data is actually many rows across and the filter only copies the 1st 6 columns over for some reason?
* The macro also seems to bizarely work on any sheet I click on, replicating what it did on the active sheet e.g. the Andy sheet works but then if I go to sheet "Irrelevant", Andy data appears there as well?

Hope you can help!
Thanks
Nick
 
Upvote 0
If you want to filter on column D, change:

.AutoFilter Field:=1, Criteria1:=Crit

to:

.AutoFilter Field:=4, Criteria1:=Crit

If you want to start in row 4 you cannot use this:

With Source.Range("A4").CurrentRegion

because it will probably also pick up rows 1 to 3. Instead, you need to use something like this:

With Source.Range("A4:A" & Source.Range("A4").End(xlDown).Row)

changing the second A in "A4:A" to be the last column in your data.

As for sheet "Irrelevant", you need to test for sheets you don't want the procedure to apply to. At present the code only tests for sheet "Input", so you need to add another line, eg:

If Sh.name = Source.name Then Exit Sub
If Sh.name = "Irrelevant" Then Exit Sub
 
Upvote 0
Thanks Andrew
It is getting there, just 1 glitch remains - the active sheets always include the 1st line of data from the input sheet even when not relevant.
I think this is something to do with what you said earlier about the code assuming there is a header row above the list.
I have tried amending the macro changing A4 for A3 in different ways but to no avail!
Can you help?
Thanks
Nick

PS latest code is.....

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Source As Worksheet
' Sheet containing data
Dim Crit As String
' Defines what sheet has the master data
Set Source = Worksheets("Input")
' Tells macro not to work on specified sheets of the workbook
If Sh.name = Source.name Then Exit Sub
If Sh.name = "Process" Then Exit Sub
If Sh.name = "Event Codes" Then Exit Sub
If Sh.name = "Order Number" Then Exit Sub
If Sh.name = "Roles" Then Exit Sub
Application.ScreenUpdating = False
' Sheet name is data required
Crit = ActiveSheet.name
With Source.Range("A4:U" & Source.Range("A4").End(xlDown).Row)
' Filter for column 7 = sheet name
.AutoFilter Field:=7, Criteria1:=Crit
' Copy data to active sheet, range decides where it goes on the active sheet
.Copy ActiveSheet.Range("A4")
' Trn off Autofilter
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,811
Messages
6,181,081
Members
453,021
Latest member
Justyna P

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
Back
Top