Hello Programmers!

I need some help with this code. The way this code is set up now, is
that it saves the file from the users input. I want to modify to save
from cell F2 from a sheet call HH1. The code to modify is in red.
Thanks in advance.

EMoe

Bythe way, this is only part of the code I can place it all here if
needed.

Sub Archive()
Application.Calculation = xlManual
adver = MsgBox("Archiving SIC data,all other excel files that are open
will close without saving changes, would you like to continue?", _
vbYesNo + vbQuestion + vbDefaultButton2, "Warning")
If adver = vbNo Then
Exit Sub
End If

For Each w In Workbooks
If w.Name < ThisWorkbook.Name Then
w.Close savechanges:=False
End If
Next w

'subroutine to name archive and unprotect sheets

FileToSave = InputBox("Save the date for data history" & _
" in the form month-day-year" & _
" example: 10-13-2003", _
"Name day to archive")

Windows("SIMONSIC.xls").Activate
Worksheets("HH1copy").Unprotect ("SICHH")
Worksheets("HH2copy").Unprotect ("SICHH")
Worksheets("Actions HH1").Unprotect ("SICHH")
Worksheets("Actions HH2").Unprotect ("SICHH")

'subroutine to create copies in a new folder and reprotect the sheet

Sheets("HH1copy").Copy

ChDrive "I:\"
ChDir "I:\PLANT\Process Control Room\ArchiveSIMONSIC"
ActiveWorkbook.SaveAs Filename:=FileToSave, FileFormat:=xlNormal,
Password:="", writerespassword:="SIC", _
ReadOnlyRecommended:=False, CreateBackup:=False

With Workbooks("SIMONSIC.xls")

..Sheets("Actions HH1").Copy After:=Workbooks(2).Sheets(1)
..Sheets("HH2copy").Copy After:=Workbooks(2).Sheets(2)
..Sheets("Actions HH2").Copy After:=Workbooks(2).Sheets(3)
End With

Windows("SIMONSIC.xls").Activate
Worksheets("HH1copy").Protect Password:="SICHH",
DrawingObjects:=True, Contents:=True, Scenarios:=True
Worksheets("HH2copy").Protect Password:="SICHH",
DrawingObjects:=True, Contents:=True, Scenarios:=True
Worksheets("Actions HH1").Protect Password:="SICHH",
DrawingObjects:=True, Contents:=True, Scenarios:=True
Worksheets("Actions HH2").Protect Password:="SICHH",
DrawingObjects:=True, Contents:=True, Scenarios:=True

'subroutine to eliminate formulas from the copies

Workbooks(2).Activate
Worksheets("HH1copy").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, operation:=xlNone,
skipblanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("a1").Select

Workbooks(2).Activate
Worksheets("HH2copy").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, operation:=xlNone,
skipblanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("a1").Select

Workbooks(2).Activate
Worksheets("Actions HH1").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, operation:=xlNone,
skipblanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("a1").Select

Workbooks(2).Activate
Worksheets("Actions HH2").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, operation:=xlNone,
skipblanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("a1").Select


ActiveWorkbook.Save


--
EMoe
------------------------------------------------------------------------
EMoe's Profile: http://www.excelforum.com/member.php...o&userid=23183
View this thread: http://www.excelforum.com/showthread...hreadid=542817