RN copy data from workbook to workbook

  • Thread starter Thread starter Robert N
  • Start date Start date
R

Robert N

Thanks for your reply.
I have never worked with Macros.
I did go to the site sugested and downloaded 1st file under filter
named "filtersAdvFilterRepFiltered.xls"
I have tried to determine how I could modify this marco to suit m
needs. This macro does exactly what I need.
My current file MasterData currently has data in Rows 65 thru 420
There are 6 columns
Code1...Job Name...Student Name...Supervisor...School...Code2
I want to create a new sheet with data for each SUPERVISOR
and then for each School.
Would anyone be willing to take the existing script as noted above an
modify it for me.
I also need to know how the button was created in the example.
Looks like a big request but I sure would appreciate some help
 
This is Debra's code after some changes:

Option Explicit

Sub ExtractSchools()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Sheet1")
With ws1
Set rng = .Range("a1:F" & .Cells(.Rows.Count, "A").End(xlUp).Row)

'Column E contains the School???
.Columns("E:E").Copy _
Destination:=.Range("L1")
.Columns("L:L").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("J1"), Unique:=True

r = .Cells(.Rows.Count, "J").End(xlUp).Row

'set up Criteria Area
'Column E contains the School???
.Range("L1").Value = .Range("E1").Value

For Each c In .Range("J2:J" & r)
.Range("L2").Value = c.Value
If WksExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("L1:L2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
.Select
.Columns("J:L").Delete
End With
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function


=====
The School name (that you're splitting on) is in column E, right?

If not, you'll have to fix two lines right after the "Column E contains the
School???" lines.

And if you want a button (normal looking), show the Forms toolbar.
View|toolbars|check Forms

Then click on the button looking icon. Draw it on your worksheet. When you let
go you can assign the macro.

If you want a Rectangle (with instructions like Deb did--or any other shape):
Show the drawing toolbar
pick out a shape you like and add it to the worksheet.
right click on it and choose assign macro.

Point at "ExtractSchools"

(or anything you renamed it to.)
 
Back
Top