Good moring all,

I'm trying to accomplish the following:

file1.xls

copy worksheet1 from file1.xls

and then insert into file2.xls without overwriting file1.xls completely.

The reason - I have one master xls file with multiple named worksheets.
Each worksheet relates to another xls file and on a weekly basis I want the
master xls file's different worksheets updated so the worksheets are
replaced but the main master xls file is not. All I've accomplished so far
is below:

Public Sub TransferData()

'Disable screen updating while the subroutine is run
Application.ScreenUpdating = False

'Unprotect all Register worksheet
Worksheets("Register").Select
ActiveSheet.Unprotect

'Define Variables
Dim szThisFileName As String
Dim szFileName As String
Dim szWindowName As String
Dim szNotes As String
Dim szPETNumber As String
Dim Response As Integer

'Set initial values
szThisFileName = ActiveWorkbook.Name
szWindowName = "Test Risk Transfer.xls"
szFileName = "C:\" & szWindowName
iRow = 1

'Check if user wants to continue
If MsgBox("This facility is only for transfering information into " _
+ "the BISTD Central Register repository database. " _
+ "Are you sure you want to continue?", vbQuestion + vbYesNo) = vbNo
Then
Exit Sub
End If

'Check if there is any data to transfer
Worksheets("Register").Select
If ActiveSheet.Range("C2") = "" Then
MsgBox ("There are no risks in the Register to " _
+ "transfer.")
ActiveSheet.Protect
Exit Sub
End If

'Create Risk Transfer workbook on C drive
On Error GoTo ir1:
Workbooks.Add
ChDir "C:\"
ActiveWorkbook.SaveAs FileName:=szFileName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Windows(szWindowName).Activate
Sheets.Add
ActiveSheet.Name = "Risk Transfers1"
Windows(szThisFileName).Activate

'Add column headings to Stakeholder Transfer workbook
Worksheets("Register").Select
ActiveSheet.Range("C1:V1").Select
Selection.Copy
Windows(szWindowName).Activate
Worksheets("Risk Transfers1").Select
ActiveSheet.Range("B1").Select
ActiveSheet.Paste
ActiveSheet.Range("A1") = "Project_No"
Windows(szThisFileName).Activate

'Copy risk data from the Register worksheet and transfer
'data into temporary workbook in C drive.

'Find last record in Register
Call DetermineRange(nor)

Worksheets("Register").Select
szPETNumber = ActiveSheet.Range("A2")
ActiveSheet.Range("C2:V" & nor).Copy

'Truncate Notes and Key Messages fields at 255 characters
'Worksheets("Transfer Sheet").Select
'szNotes = Worksheets("Stakeholder " & szStakeholder).Range("C66")
'szNotes = Left(szNotes, 255)
'szKeyMessages = Worksheets("Stakeholder " & szStakeholder).Range("C71")
'szKeyMessages = Left(szKeyMessages, 255)

'Paste the copied data into the Risk Transfer workbook
Windows(szWindowName).Activate
ActiveSheet.Name = "Risk Transfers1"
ActiveSheet.Range("B2").Select
ActiveSheet.Paste

'Write in the Project Number on each row
ActiveSheet.Range("A2:A" & nor) = szPETNumber

'Return to the Risk Register
Windows(szThisFileName).Activate
Application.CutCopyMode = False

'Save and close risk Transfer workbook
Windows(szWindowName).Activate
ActiveWorkbook.Save
ActiveWindow.Close
Windows(szThisFileName).Activate


'Protect Register worksheet
Worksheets("Register").Select
ActiveSheet.Protect
Worksheets("FrontScreen").Select
Exit Sub

ir1: Response = MsgBox("You already have a risk Transfer workbook " _
+ "in your C Drive. Do you want to " _
+ "delete this existing Risk Transfer workbook " _
+ "and replace it with a new version?", vbYesNo)
If Response = vbYes Then
MsgBox ("Click the Transfer Data button " _
+ "again and when prompted that there is an existing " _
+ "risk Transfer file and asking if you " _
+ "wish to replace it, click Yes.")
MsgBox ("You will have created a temporary workbook called Book
" _
+ "Book*.xls. You will need to delete this when you finish the
session.")
GoTo ir2:
Else
GoTo ir2:
End If

ir2: Windows(szThisFileName).Activate
Worksheets("Register").Select
ActiveSheet.Protect
Worksheets("FrontScreen").Select
Exit Sub
End Sub