Inserting worksheet

J

jkepley75

I would like to insert a worksheet template into a workbook by simpl
inserting a specified number into a cell. For example

1 = DA.xlt
2 = CPC.xlt

It would put these files into my workbook by inserting 1 or 2
Any help is appreciated
 
J

jeff

Hi,

Here's some code that should do it for you - you may
need to adjust the DIR line.

good luck!
jeff

Sub CopySheets(booknum As Integer)
'MsgBox "made it"
'Exit Sub
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = SaveDriveDir ' or set your own "C:\Data"
ChDrive MyPath
ChDir MyPath
If booknum = 1 Then
FNames = "DA.xlt"
Else
FNames = "CPC.xlt"
End If
'FNames = Dir("*.xls")
'If Len(FNames) = 0 Then
' MsgBox "No files in the Directory"
' ChDrive SaveDriveDir
' ChDir SaveDriveDir
' Exit Sub
'End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
'Do While FNames <> ""
If FNames <> ThisWorkbook.Name Then
Set mybook = Workbooks.Open(FNames)
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0

' You can use this if you want to copy only the
values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With

mybook.Close False
End If
'FNames = Dir()
'Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("c1:c1")) Is Nothing Then
Exit Sub
If Target.Value = 1 Or Target.Value = 2 Then
CopySheets (Val(Target.Value))
End If
End Sub
 
Top