View Single Post
  #7   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

yep...... guilty as charged!
i'm very glad it worked!
a lot of it is just learning to comb the newsgroup & pulling out bits
& pieces of what you need, and then combining it to work as one sub.
susan


On Apr 24, 5:55 am, Greg wrote:
On Apr 24, 12:20 am, Susan wrote:





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


Ah Susan! Your an angel!!! Thank you so much. You really must have
a passion for this stuff.

Greg- Hide quoted text -

- Show quoted text -