Hi,

I need to copy an instruction sheet from one workbook into a series of
workbooks. When I run the following procedure, I either get a
'Subscript out of Range' , or the procedure runs, but does not copy
the sheet. Any help you can lend with this would be most helpful.

--------------------------------------------

Sub Insert_Instructions()

Dim wbSource As Workbook
Dim wsInstructions As Worksheet

Dim vPath ' Unsure - string or variant?
Dim vName ' Unsure - string or variant?

Set wbSource = Workbooks.Open("c:\Instructions.xls")
Set wsInstructions = wbSource.Worksheets("Instructions")

vPath = "c:\ChangeRequests\"
vName = Dir(vPath, vbNormal)
Do While Not vName < ""
If (GetAttr(vPath & vName) And vbNormal) = vbNormal Then
Workbooks.Open vPath & vName
wsInstructions.Copy Befo=Workbooks(vPath &
vName).Sheets(1)
Workbooks(vPath & vName).Save
Workbooks(vPath & vName).Close
End If

vName = Dir
Loop

wbSource.Close SaveChanges:=False

Set wsInstructions = Nothing
Set wbSource = Nothing

End Sub

--------------------------------------------

Henry

Sub Insert_Instructions()

Dim wbSource As Workbook
Dim wsInstructions As Worksheet

Dim vPath as string
Dim vName as Striing


Set wbSource = Workbooks.Open("c:\Instructions.xls")
Set wsInstructions = wbSource.Worksheets("Instructions")

vPath = "c:\ChangeRequests\"
vName = Dir(vPath, vbNormal)
Do While Not vName < ""
If (GetAttr(vPath & vName) And vbNormal) = vbNormal Then
Workbooks.Open vPath & vName
wsInstructions.Copy Befo=Workbooks(vName).Sheets(1)
Workbooks(vName).Close SaveChanges:=True
End If

vName = Dir
Loop

wbSource.Close SaveChanges:=False

Set wsInstructions = Nothing
Set wbSource = Nothing

End Sub

--
Regards,
Tom Ogilvy


"Henry Stockbridge" wrote:

Hi,

I need to copy an instruction sheet from one workbook into a series of
workbooks. When I run the following procedure, I either get a
'Subscript out of Range' , or the procedure runs, but does not copy
the sheet. Any help you can lend with this would be most helpful.

--------------------------------------------

Sub Insert_Instructions()

Dim wbSource As Workbook
Dim wsInstructions As Worksheet

Dim vPath ' Unsure - string or variant?
Dim vName ' Unsure - string or variant?

Set wbSource = Workbooks.Open("c:\Instructions.xls")
Set wsInstructions = wbSource.Worksheets("Instructions")

vPath = "c:\ChangeRequests\"
vName = Dir(vPath, vbNormal)
Do While Not vName < ""
If (GetAttr(vPath & vName) And vbNormal) = vbNormal Then
Workbooks.Open vPath & vName
wsInstructions.Copy Befo=Workbooks(vPath &
vName).Sheets(1)
Workbooks(vPath & vName).Save
Workbooks(vPath & vName).Close
End If

vName = Dir
Loop

wbSource.Close SaveChanges:=False

Set wsInstructions = Nothing
Set wbSource = Nothing

End Sub

--------------------------------------------

Henry

On Jul 7, 9:12 am, Tom Ogilvy
wrote:
Sub Insert_Instructions()

Dim wbSource As Workbook
Dim wsInstructions As Worksheet

Dim vPath as string
Dim vName as Striing

Set wbSource = Workbooks.Open("c:\Instructions.xls")
Set wsInstructions = wbSource.Worksheets("Instructions")

vPath = "c:\ChangeRequests\"
vName = Dir(vPath, vbNormal)
Do While Not vName < ""
If (GetAttr(vPath & vName) And vbNormal) = vbNormal Then
Workbooks.Open vPath & vName
wsInstructions.Copy Befo=Workbooks(vName).Sheets(1)
Workbooks(vName).Close SaveChanges:=True
End If

vName = Dir
Loop

wbSource.Close SaveChanges:=False

Set wsInstructions = Nothing
Set wbSource = Nothing

End Sub

--
Regards,
Tom Ogilvy



"Henry Stockbridge" wrote:
Hi,

I need to copy an instruction sheet from one workbook into a series of
workbooks. When I run the following procedure, I either get a
'Subscript out of Range' , or the procedure runs, but does not copy
the sheet. Any help you can lend with this would be most helpful.

--------------------------------------------

Sub Insert_Instructions()

Dim wbSource As Workbook
Dim wsInstructions As Worksheet

Dim vPath ' Unsure - string or variant?
Dim vName ' Unsure - string or variant?

Set wbSource = Workbooks.Open("c:\Instructions.xls")
Set wsInstructions = wbSource.Worksheets("Instructions")

vPath = "c:\ChangeRequests\"
vName = Dir(vPath, vbNormal)
Do While Not vName < ""
If (GetAttr(vPath & vName) And vbNormal) = vbNormal Then
Workbooks.Open vPath & vName
wsInstructions.Copy Befo=Workbooks(vPath &
vName).Sheets(1)
Workbooks(vPath & vName).Save
Workbooks(vPath & vName).Close
End If

vName = Dir
Loop

wbSource.Close SaveChanges:=False

Set wsInstructions = Nothing
Set wbSource = Nothing

End Sub

--------------------------------------------

Henry- Hide quoted text -

- Show quoted text -

===========================
Tom,

Thanks for the help. Your code works like a charm.

Henry

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