automating a procedure
 

I wrote a procedure that takes selected sheets from several workbooks and
copies them into the workbook which is running the procedure. The names and
locations of the source sheet are hard coded into the procedure (shown
below). I need to do this numerous times with different workbook locations
and sources. I created a workbook with a single worksheet having in column 1
the location of the destination book, and in column2 the names of the
relevant source workbooks. I want to use this spreadsheet to generalize my
procedure - I want the procedure attached to the spreadsheet, and I want it
to loop through the sheet using its contents as parameters for the procedure.
Can I do this? - I am new to visual basic, and I am having a lot of
trouble adapting it. The destination worksheet would no longer be the
worksheet running the procedure, but the worksheet located in the directory
indicated in the table. Can anyone give me some advice on how to do this, or
point me to an example of a similar procedure?

Here is the original (non-generalized) code:
Sub reset()
' the purpose of this module is to copy selected worksheets from the
' budget master files into this book, replacing the sheets that are
' now there. The workbook names are hardcoded in, the sheetnames should
' match the names on the existing worksheets.

Dim basebook As Workbook
Dim sourcebook As Workbook
Dim sourcerange As Range
Dim destrange As Range
Dim rnum As Long
Dim fnames As String
Dim NAMEARRAY As Variant
Dim UPDATELINKS As Integer
Dim mypath As String
Dim sheetnames As String
Dim SH As Worksheet
Dim destsh As Worksheet
Dim destcount As Integer
Dim i As Integer
Dim j As Integer

Dim matchcount As Integer


UPDATELINKS = 0
mypath = "K:\BUDGET\master files"
ChDrive mypath
ChDir mypath

' the contents of this array needs to come out of the spreadsheet column 2
NAMEARRAY = Array("sum200.xls", "sum100.xls")

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
destcount = ThisWorkbook.Worksheets.Count

matchcount = 0
rnum = 0
Do While (rnum < 2) And (matchcount < destcount)
fnames = NAMEARRAY(rnum)
Set sourcebook = Workbooks.Open(fnames, UPDATELINKS)
basebook.Worksheets(rnum + 1).Cells.Clear

For Each SH In sourcebook.Worksheets
For i = 1 To destcount
Set destsh = basebook.Worksheets(rnum + 1)

If SH.Name = destsh.Name Then
SH.Range("A1:AC54").Copy destsh.Cells(1, 1)
matchcount = matchcount + 1
Exit For
End If
Next i
If matchcount = destcount Then Exit For
Next SH
rnum = rnum + 1
Workbooks(fnames).Close SaveChanges:=False
Loop

' the directory between budget and blank forms needs to come out of the
' spreadsheet column 1
basebook.SaveAs Filename:="J:\budget\assessor\blank forms\budget.xls"


End Sub

automating a procedure
 

If your location of the destination book and name is in A1
names of the relevant source workbooks in B1, B2 etc

Would you try replacing
NAMEARRAY = Array("sum200.xls", "sum100.xls")
basebook.SaveAs Filename:="J:\budget\assessor\blank forms\budget.xls"

with
NAMEARRAY = Array(range("B1"), range("B2"), .....)
basebook.SaveAs Filename:=range("A1")

please?

"SandyR" wrote:

I wrote a procedure that takes selected sheets from several workbooks and
copies them into the workbook which is running the procedure. The names and
locations of the source sheet are hard coded into the procedure (shown
below). I need to do this numerous times with different workbook locations
and sources. I created a workbook with a single worksheet having in column 1
the location of the destination book, and in column2 the names of the
relevant source workbooks. I want to use this spreadsheet to generalize my
procedure - I want the procedure attached to the spreadsheet, and I want it
to loop through the sheet using its contents as parameters for the procedure.
Can I do this? - I am new to visual basic, and I am having a lot of
trouble adapting it. The destination worksheet would no longer be the
worksheet running the procedure, but the worksheet located in the directory
indicated in the table. Can anyone give me some advice on how to do this, or
point me to an example of a similar procedure?

Here is the original (non-generalized) code:
Sub reset()
' the purpose of this module is to copy selected worksheets from the
' budget master files into this book, replacing the sheets that are
' now there. The workbook names are hardcoded in, the sheetnames should
' match the names on the existing worksheets.

Dim basebook As Workbook
Dim sourcebook As Workbook
Dim sourcerange As Range
Dim destrange As Range
Dim rnum As Long
Dim fnames As String
Dim NAMEARRAY As Variant
Dim UPDATELINKS As Integer
Dim mypath As String
Dim sheetnames As String
Dim SH As Worksheet
Dim destsh As Worksheet
Dim destcount As Integer
Dim i As Integer
Dim j As Integer

Dim matchcount As Integer


UPDATELINKS = 0
mypath = "K:\BUDGET\master files"
ChDrive mypath
ChDir mypath

' the contents of this array needs to come out of the spreadsheet column 2
NAMEARRAY = Array("sum200.xls", "sum100.xls")

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
destcount = ThisWorkbook.Worksheets.Count

matchcount = 0
rnum = 0
Do While (rnum < 2) And (matchcount < destcount)
fnames = NAMEARRAY(rnum)
Set sourcebook = Workbooks.Open(fnames, UPDATELINKS)
basebook.Worksheets(rnum + 1).Cells.Clear

For Each SH In sourcebook.Worksheets
For i = 1 To destcount
Set destsh = basebook.Worksheets(rnum + 1)

If SH.Name = destsh.Name Then
SH.Range("A1:AC54").Copy destsh.Cells(1, 1)
matchcount = matchcount + 1
Exit For
End If
Next i
If matchcount = destcount Then Exit For
Next SH
rnum = rnum + 1
Workbooks(fnames).Close SaveChanges:=False
Loop

' the directory between budget and blank forms needs to come out of the
' spreadsheet column 1
basebook.SaveAs Filename:="J:\budget\assessor\blank forms\budget.xls"


End Sub

automating a procedure
 

Thanks for the suggestion - it put me in a slightly different direction, and
I have resumed making progress!

"PY & Associates" wrote:

If your location of the destination book and name is in A1
names of the relevant source workbooks in B1, B2 etc

Would you try replacing
NAMEARRAY = Array("sum200.xls", "sum100.xls")
basebook.SaveAs Filename:="J:\budget\assessor\blank forms\budget.xls"

with
NAMEARRAY = Array(range("B1"), range("B2"), .....)
basebook.SaveAs Filename:=range("A1")

please?

"SandyR" wrote:

I wrote a procedure that takes selected sheets from several workbooks and
copies them into the workbook which is running the procedure. The names and
locations of the source sheet are hard coded into the procedure (shown
below). I need to do this numerous times with different workbook locations
and sources. I created a workbook with a single worksheet having in column 1
the location of the destination book, and in column2 the names of the
relevant source workbooks. I want to use this spreadsheet to generalize my
procedure - I want the procedure attached to the spreadsheet, and I want it
to loop through the sheet using its contents as parameters for the procedure.
Can I do this? - I am new to visual basic, and I am having a lot of
trouble adapting it. The destination worksheet would no longer be the
worksheet running the procedure, but the worksheet located in the directory
indicated in the table. Can anyone give me some advice on how to do this, or
point me to an example of a similar procedure?

Here is the original (non-generalized) code:
Sub reset()
' the purpose of this module is to copy selected worksheets from the
' budget master files into this book, replacing the sheets that are
' now there. The workbook names are hardcoded in, the sheetnames should
' match the names on the existing worksheets.

Dim basebook As Workbook
Dim sourcebook As Workbook
Dim sourcerange As Range
Dim destrange As Range
Dim rnum As Long
Dim fnames As String
Dim NAMEARRAY As Variant
Dim UPDATELINKS As Integer
Dim mypath As String
Dim sheetnames As String
Dim SH As Worksheet
Dim destsh As Worksheet
Dim destcount As Integer
Dim i As Integer
Dim j As Integer

Dim matchcount As Integer


UPDATELINKS = 0
mypath = "K:\BUDGET\master files"
ChDrive mypath
ChDir mypath

' the contents of this array needs to come out of the spreadsheet column 2
NAMEARRAY = Array("sum200.xls", "sum100.xls")

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
destcount = ThisWorkbook.Worksheets.Count

matchcount = 0
rnum = 0
Do While (rnum < 2) And (matchcount < destcount)
fnames = NAMEARRAY(rnum)
Set sourcebook = Workbooks.Open(fnames, UPDATELINKS)
basebook.Worksheets(rnum + 1).Cells.Clear

For Each SH In sourcebook.Worksheets
For i = 1 To destcount
Set destsh = basebook.Worksheets(rnum + 1)

If SH.Name = destsh.Name Then
SH.Range("A1:AC54").Copy destsh.Cells(1, 1)
matchcount = matchcount + 1
Exit For
End If
Next i
If matchcount = destcount Then Exit For
Next SH
rnum = rnum + 1
Workbooks(fnames).Close SaveChanges:=False
Loop

' the directory between budget and blank forms needs to come out of the
' spreadsheet column 1
basebook.SaveAs Filename:="J:\budget\assessor\blank forms\budget.xls"


End Sub