View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Susan Susan is offline
external usenet poster
 
Posts: 1,117
Default script to send data from worksheet to multiple workbooks

ok, greg, here's what i've got for you.
this is controlled by a command button on the main worksheet.......

Option Explicit

Private Sub CommandButton1_Click()

Call Export

End Sub


Option Explicit

Public lName As String
Public fName As String
Public mName As String
Public sRank As String
Public iloc As Integer
Public rRange, GroupRange, PersonRange As Range
Public wb1, wb2 As Workbook
Public ws1, ws2 As Worksheet
Public iRow, iiRow As Integer
Public c As Range
Public sStudent As String
Public sFile, sPath As String
'

Public Sub Export()

Set wb1 = ActiveWorkbook
Set ws1 = ActiveSheet

'CHANGE rRange TO YOUR ACTUAL RANGE OF
'STUDENT'S NAMES
Set rRange = ws1.Range("a3:a7")

'CHANGE sPath TO YOUR ACTUAL PATH
sPath = "\\Server\users\Susan\My Documents\Miscellaneous\01Excel\Macro
Projects-Excel\Tests\PersonalWkbks\"

'go to the top of the range that has the student's names
ws1.Range("a3").Select
iRow = ActiveCell.Row

For Each c In rRange
'this is the range of the old workbook with all the students
'that is JUST the row of the one student you're working
'on
Set GroupRange = ws1.Range("b" & iRow & ":g" & iRow)

Call SplitName(c)

sStudent = lName
sFile = "_personalgrades.xls"
Workbooks.Open Filename:=sPath & sStudent & sFile

Set wb2 = ActiveWorkbook
Set ws2 = ActiveSheet
'iiRow is the first blank row in column B - column A contains
'the student's name in my sample workbook.

iiRow = ws2.Cells(5000, 2).End(xlUp).Offset(1, 0).Row
'this is the range in the individual's workbook
'it contains just one row
Set PersonRange = ws2.Range("b" & iiRow & ":g" & iiRow)

GroupRange.Copy
PersonRange.PasteSpecial

wb2.Save
wb2.Close
iRow = iRow + 1

Next c

End Sub


Public Sub SplitName(sName)

sName = Trim(sName) 'this is taking spaces off the end or beginning
of the name
iloc = InStr(sName, ",") 'this is the # position of the comma
lName = Left(sName, iloc - 1) 'this is the last name, before the
comma

'sub above taken from newsgroup with this
'disclaimer from Tom:
'the sub above won't correctly handle
'
'Smith, Joe Bob R. Pvt
'Smith, Mike Cpl
'Smith, Bill H Pfc
'
'Regards,
'Tom Ogilvy

End Sub


it worked for me with limited testing.
HTH!
:)
susan