Selecting Each Row and Creating a New File

[Shai Shefer]

Hi,

I am trying to build an attendance list, where students go down the
left hand side of the sheet and dates go along the top. Each student
has an "X" in the cell where he/she attended class.

I have been trying to build a macro that will take each row, starting
with the students, copy the header and the student row and put those in
a new workbook that has the name of the student and just his/her
absences...

I am fairly new and was wondering if anyone could give me any good
links or help that may guide me in the right direction. I am able to
create a new workbook successfully but need more help on how to get the
data copied over.

Thank you for any help!

Shai Shefer

 

[Ron de Bruin]

Hi Shai

Try this
http://www.rondebruin.nl/copy5.htm

Test this one
http://www.rondebruin.nl/copy5.htm#workbook

 

[Shai Shefer]

Thanks for the quick response! I dont really understand the code from
that example, but I am still trying to play around and see what I can
take away...

My code is below for review, I am basically still trying to find out
how to:
- Copy those selected ranges into the new workbook
- Loop through list of students
=====================================
Sub AssignRow()

Dim MyPath As String
Dim PersonalInfo As Range
Dim Header As Range

MyPath = "C:\Attend"

Set Headers = Worksheets("Student Class Matrix").Range("1:7")
Set PersonalInfo = Worksheets("Student Class Matrix").Range("8:8")

If MsgBox("Are you sure you wish to seperate each row into a unique
file ?", vbYesNo + vbQuestion) = vbNo _
Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'select the header range and name range and copy it


Set NewBook = Workbooks.Add
With NewBook
.Title = "Training"
.Subject = "Training Update"
.Worksheets("Sheet1").Select
.Worksheets("Sheet1").Range("1:7").Select
.Worksheets("Sheet1").Range("8:8").Select
.Worksheets("Sheet2").Delete
.Worksheets("Sheet3").Delete
.Sheets("Sheet1").Name = "student_name"
.SaveAs Filename:=(MyPath & "\" & "test.xls")
End With

Workbooks("test.xls").Close savechanges:=False 'true ???

Application.DisplayAlerts = True
Application.ScreenUpdating = True

'completion message
MsgBox "Process Completed."

End Sub

=====================================

 

[Shai Shefer]

Is there any code out there that is slightly better documented?

I have all I need I just cant seem to copy and paste my rows to the
newly created worksheet!

 

[Ron de Bruin]

Hi Shai

In which row are the dates
In which column are the names

 

[Shai Shefer]

Thanks again for the quick reply...

The names are in column B starting with row 8, and I have date and
other information (legend) in the range A1I7

Any advice?

 

[Ron de Bruin]

It is important that row 7 have unique headers

Then use a fixed range like A7I1000 and chnage the filter column to 2

Set rng = ws1.Range("A7I1000")

rng.Columns(2).AdvancedFilter _

 

[Shai Shefer]

Thanks, one quick question.

After I capture that range in rng, how do I paste it?

Something like:
..ActiveSheet.Paste.MyInfo

or no?

 

[Shai Shefer]

Note: MyInfo is the range I captured and am trying to paste

Or;

..Worksheets("Sheet1").Range("B" & i & "I" & i).Select
..MyInfo.Paste

Neither of these seem to work

 

[Ron de Bruin]

We go test it so you can see what it does

Create a sheet with data in A120
In row 1 enter headers
in A2:A20 enter names
in B220 enter something

Now run the exact macro on my site

 

[Shai Shefer]

For the record, this was my final code. Thank you guys for all the
help.

Hope this helps someone!
=====================================================
Sub Rows_To_Excel_Files()

Dim MyPath As String
Dim MyName As String
Dim MyInfo As Range
Dim c As Range
Dim i As Integer

MyPath = "C:\Attendance"

If MsgBox("Are you sure you wish to seperate each row into a unique
file ?", vbYesNo + vbQuestion) = vbNo _
Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayAlerts = False

i = 8
For Each c In Worksheets("Student Class Matrix").Range("8:60").Rows

Worksheets("Student Class Matrix").Range("B" & i).Select
MyName = ActiveCell.Value

Worksheets("Student Class Matrix").Range("A1I7").Select
Selection.Copy

Set MyInfo = Worksheets("Student Class Matrix").Range("A" & i &
"I" & i)

Set NewBook = Workbooks.Add
With NewBook
.Title = "Attendance"
.Subject = "Attendance Update"
.Worksheets("Sheet1").Select
.ActiveSheet.Paste
Destination:=Worksheets("Sheet1").Range("A1I7")
.Worksheets("Sheet1").Range("A8I8").Value = MyInfo.Value
.Worksheets("Sheet1").Columns.AutoFit
.Worksheets("Sheet2").Delete
.Worksheets("Sheet3").Delete
.Sheets("Sheet1").name = MyName
.SaveAs Filename:=(MyPath & "\" & "Attendance - " & MyName &
".xls")
End With

Workbooks("Attendance - " & MyName & ".xls").Close
savechanges:=False

i = i + 1
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox "Process Completed."

End Sub
=====================================================