E
EMoe
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
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