The code below copies a worksheet into a new book and then emails the
new workbook. When the original worksheet is copied to a new workbook
how can I modify my code to also copy Module5 to the new workbook?

My Code:



Sub MoveData()
On Error GoTo ErrHandler
Dim lastrow As Long, TempFilePath As String, TempFileName As String,
lastemail As Byte
Dim MyRecipients() As Variant, cel As Range, rg As Range, i As Long,
response As Byte
Dim TempCleanName As String, TempDateName As String

response = MsgBox("Are you sure you want to process this
request?", vbQuestion + vbOKCancel, "Confirm request process")

If response = vbCancel Then
End
End If

If Range("B4") = "" Or Range("B5") = "" Or Range("A8") = "" Or
Range("B8") = "" Or Range("C8") = "" Or Range("D8") = "" Or
Range("E8") = "" Or Range("A20") = "" Or Range("B22") = "" Then
MsgBox "Form was not properly filled out, please check the
values and try again.", vbInformation, "Missing Data"
End
End If

Sheets("EMAIL LIST").Select
Cells.Select
ActiveSheet.Unprotect Password:="sj23"
Range("A1").Select
'removes hyperlinks
lastemail = Range("A65536").End(xlUp).Row

Columns("A:A").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
Range("A1").Select

Range("A2", "A" & lastemail).Select
Selection.Hyperlinks.Delete

Range("A1").Select

'creates array of email addy's for use with sendmail
Set rg = Sheets("EMAIL LIST").Range([A2], [A65536].End(xlUp))
ReDim MyRecipients(Application.CountA(rg))
For Each cel In rg
If cel <> "" Then
MyRecipients(i) = cel
i = i + 1
End If
Next

'copy worksheet to new workbook
ThisWorkbook.Sheets("Move Request").Copy
ActiveSheet.Unprotect Password:="2j23"
'get path for temp directory
Range("H6").Select
Selection.ClearContents
Range("A1:G22").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$23"
Range("A5").Select
Range("A1").Select
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 100
Cells.Select
Selection.Locked = True
Selection.FormulaHidden = False

TempFilePath = Environ$("temp") & "\"
'generate filename
'calls function to parse out invalid name characters
TempCleanName = CleanData(ActiveWorkbook.Sheets("Move
Request").Range("B4").Value)
TempDateName = ActiveWorkbook.Sheets("Move
Request").Range("F4").Value
TempFileName = TempCleanName & " " & Format(TempDateName,
"dd-mmm-yy") & ".xls"
Range("A4").Select
'save workbook with temp name to temp path
ActiveWorkbook.SaveAs Filename:=TempFilePath & TempFileName
ActiveWorkbook.Sheets("Move Request").Select

'format worksheet to send as attachment
ActiveSheet.Unprotect
Rows("41:43").Delete
ActiveSheet.Shapes("Rectangle 3").Delete
ActiveSheet.Shapes("Rectangle 2").Delete
Range("G5").Select
Range("A4").Select
ActiveSheet.Protect Password:="2j23"
'send as attachment
ActiveWorkbook.SendMail Recipients:=MyRecipients, Subject:="MOVE
REQUEST for " & _
Range("B4").Value & " " & Range("F5").Value & " " &
Range("B5").Value & " requested: " &
Format(ActiveWorkbook.Sheets("Move Request").Range("F4").Value,
"mmm/dd/yy")
'close without saving and delete temp file
ActiveWorkbook.Close SaveChanges:=False
Kill TempFilePath & TempFileName

'ThisWorkbook.Sheets("Move Request").Select
'copy the data in the form
'Range("A43:P43").Select
'Selection.Copy

'ThisWorkbook.Sheets("Data Logs").Select
'paste the data from the form into the table
'lastrow = Range("A65536").End(xlUp).Row
'Range("A" & lastrow + 1).Select
'Selection.PasteSpecial Paste:=xlPasteValues
'Range("A" & lastrow + 1).Select

ThisWorkbook.Sheets("Move Request").Select
'clear the data from the form
Call ClearData

Sheets("EMAIL LIST").Select
ActiveSheet.Protect Password:="2j23"

Sheets("Move Request").Select
ActiveSheet.Protect Password:="2j23"
Range("A1").Select

ExitHere:
Exit Sub
ErrHandler:
MsgBox "An unexpected error occured, please check the data and try
again" & vbCrLf & _
Error$, vbCritical, "Unexpected Error"
Resume ExitHere
End Sub




Thanks for you help

Penny: Instead of creating a new workbook, Open up an empty xls file that
contains module 2. Then copy the worksheet into opened file and saveas a new
filename as you have already done in your code.

"Little Penny" wrote:

> The code below copies a worksheet into a new book and then emails the
> new workbook. When the original worksheet is copied to a new workbook
> how can I modify my code to also copy Module5 to the new workbook?
>
> My Code:
>
>
>
> Sub MoveData()
> On Error GoTo ErrHandler
> Dim lastrow As Long, TempFilePath As String, TempFileName As String,
> lastemail As Byte
> Dim MyRecipients() As Variant, cel As Range, rg As Range, i As Long,
> response As Byte
> Dim TempCleanName As String, TempDateName As String
>
> response = MsgBox("Are you sure you want to process this
> request?", vbQuestion + vbOKCancel, "Confirm request process")
>
> If response = vbCancel Then
> End
> End If
>
> If Range("B4") = "" Or Range("B5") = "" Or Range("A8") = "" Or
> Range("B8") = "" Or Range("C8") = "" Or Range("D8") = "" Or
> Range("E8") = "" Or Range("A20") = "" Or Range("B22") = "" Then
> MsgBox "Form was not properly filled out, please check the
> values and try again.", vbInformation, "Missing Data"
> End
> End If
>
> Sheets("EMAIL LIST").Select
> Cells.Select
> ActiveSheet.Unprotect Password:="sj23"
> Range("A1").Select
> 'removes hyperlinks
> lastemail = Range("A65536").End(xlUp).Row
>
> Columns("A:A").Select
> Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
> Header:=xlGuess, _
> OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
> _
> DataOption1:=xlSortNormal
> Range("A1").Select
>
> Range("A2", "A" & lastemail).Select
> Selection.Hyperlinks.Delete
>
> Range("A1").Select
>
> 'creates array of email addy's for use with sendmail
> Set rg = Sheets("EMAIL LIST").Range([A2], [A65536].End(xlUp))
> ReDim MyRecipients(Application.CountA(rg))
> For Each cel In rg
> If cel <> "" Then
> MyRecipients(i) = cel
> i = i + 1
> End If
> Next
>
> 'copy worksheet to new workbook
> ThisWorkbook.Sheets("Move Request").Copy
> ActiveSheet.Unprotect Password:="2j23"
> 'get path for temp directory
> Range("H6").Select
> Selection.ClearContents
> Range("A1:G22").Select
> ActiveSheet.PageSetup.PrintArea = "$A$1:$G$23"
> Range("A5").Select
> Range("A1").Select
> ActiveWindow.View = xlPageBreakPreview
> ActiveWindow.Zoom = 100
> Cells.Select
> Selection.Locked = True
> Selection.FormulaHidden = False
>
> TempFilePath = Environ$("temp") & "\"
> 'generate filename
> 'calls function to parse out invalid name characters
> TempCleanName = CleanData(ActiveWorkbook.Sheets("Move
> Request").Range("B4").Value)
> TempDateName = ActiveWorkbook.Sheets("Move
> Request").Range("F4").Value
> TempFileName = TempCleanName & " " & Format(TempDateName,
> "dd-mmm-yy") & ".xls"
> Range("A4").Select
> 'save workbook with temp name to temp path
> ActiveWorkbook.SaveAs Filename:=TempFilePath & TempFileName
> ActiveWorkbook.Sheets("Move Request").Select
>
> 'format worksheet to send as attachment
> ActiveSheet.Unprotect
> Rows("41:43").Delete
> ActiveSheet.Shapes("Rectangle 3").Delete
> ActiveSheet.Shapes("Rectangle 2").Delete
> Range("G5").Select
> Range("A4").Select
> ActiveSheet.Protect Password:="2j23"
> 'send as attachment
> ActiveWorkbook.SendMail Recipients:=MyRecipients, Subject:="MOVE
> REQUEST for " & _
> Range("B4").Value & " " & Range("F5").Value & " " &
> Range("B5").Value & " requested: " &
> Format(ActiveWorkbook.Sheets("Move Request").Range("F4").Value,
> "mmm/dd/yy")
> 'close without saving and delete temp file
> ActiveWorkbook.Close SaveChanges:=False
> Kill TempFilePath & TempFileName
>
> 'ThisWorkbook.Sheets("Move Request").Select
> 'copy the data in the form
> 'Range("A43:P43").Select
> 'Selection.Copy
>
> 'ThisWorkbook.Sheets("Data Logs").Select
> 'paste the data from the form into the table
> 'lastrow = Range("A65536").End(xlUp).Row
> 'Range("A" & lastrow + 1).Select
> 'Selection.PasteSpecial Paste:=xlPasteValues
> 'Range("A" & lastrow + 1).Select
>
> ThisWorkbook.Sheets("Move Request").Select
> 'clear the data from the form
> Call ClearData
>
> Sheets("EMAIL LIST").Select
> ActiveSheet.Protect Password:="2j23"
>
> Sheets("Move Request").Select
> ActiveSheet.Protect Password:="2j23"
> Range("A1").Select
>
> ExitHere:
> Exit Sub
> ErrHandler:
> MsgBox "An unexpected error occured, please check the data and try
> again" & vbCrLf & _
> Error$, vbCritical, "Unexpected Error"
> Resume ExitHere
> End Sub
>
>
>
>
> Thanks for you help
>

The original spreadsheet is really a form that other people use to
request information. When the form (originals spreadsheet) which is
password protected and sits on a network drive is filled out it copies
itself to a new workbook save itself with the name the users request
and email itself to me.

There is a macro button on the spreadsheet that once the use fills in
all the information that activates this code.

The way it is now the user just fills in the info and presses a
button.

I'm I making any sense












On Sat, 15 Sep 2007 11:42:01 -0700, Joel
<(E-Mail Removed)> wrote:

>Penny: Instead of creating a new workbook, Open up an empty xls file that
>contains module 2. Then copy the worksheet into opened file and saveas a new
>filename as you have already done in your code.
>
>"Little Penny" wrote:
>
>> The code below copies a worksheet into a new book and then emails the
>> new workbook. When the original worksheet is copied to a new workbook
>> how can I modify my code to also copy Module5 to the new workbook?
>>
>> My Code:
>>
>>
>>
>> Sub MoveData()
>> On Error GoTo ErrHandler
>> Dim lastrow As Long, TempFilePath As String, TempFileName As String,
>> lastemail As Byte
>> Dim MyRecipients() As Variant, cel As Range, rg As Range, i As Long,
>> response As Byte
>> Dim TempCleanName As String, TempDateName As String
>>
>> response = MsgBox("Are you sure you want to process this
>> request?", vbQuestion + vbOKCancel, "Confirm request process")
>>
>> If response = vbCancel Then
>> End
>> End If
>>
>> If Range("B4") = "" Or Range("B5") = "" Or Range("A8") = "" Or
>> Range("B8") = "" Or Range("C8") = "" Or Range("D8") = "" Or
>> Range("E8") = "" Or Range("A20") = "" Or Range("B22") = "" Then
>> MsgBox "Form was not properly filled out, please check the
>> values and try again.", vbInformation, "Missing Data"
>> End
>> End If
>>
>> Sheets("EMAIL LIST").Select
>> Cells.Select
>> ActiveSheet.Unprotect Password:="sj23"
>> Range("A1").Select
>> 'removes hyperlinks
>> lastemail = Range("A65536").End(xlUp).Row
>>
>> Columns("A:A").Select
>> Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
>> Header:=xlGuess, _
>> OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
>> _
>> DataOption1:=xlSortNormal
>> Range("A1").Select
>>
>> Range("A2", "A" & lastemail).Select
>> Selection.Hyperlinks.Delete
>>
>> Range("A1").Select
>>
>> 'creates array of email addy's for use with sendmail
>> Set rg = Sheets("EMAIL LIST").Range([A2], [A65536].End(xlUp))
>> ReDim MyRecipients(Application.CountA(rg))
>> For Each cel In rg
>> If cel <> "" Then
>> MyRecipients(i) = cel
>> i = i + 1
>> End If
>> Next
>>
>> 'copy worksheet to new workbook
>> ThisWorkbook.Sheets("Move Request").Copy
>> ActiveSheet.Unprotect Password:="2j23"
>> 'get path for temp directory
>> Range("H6").Select
>> Selection.ClearContents
>> Range("A1:G22").Select
>> ActiveSheet.PageSetup.PrintArea = "$A$1:$G$23"
>> Range("A5").Select
>> Range("A1").Select
>> ActiveWindow.View = xlPageBreakPreview
>> ActiveWindow.Zoom = 100
>> Cells.Select
>> Selection.Locked = True
>> Selection.FormulaHidden = False
>>
>> TempFilePath = Environ$("temp") & "\"
>> 'generate filename
>> 'calls function to parse out invalid name characters
>> TempCleanName = CleanData(ActiveWorkbook.Sheets("Move
>> Request").Range("B4").Value)
>> TempDateName = ActiveWorkbook.Sheets("Move
>> Request").Range("F4").Value
>> TempFileName = TempCleanName & " " & Format(TempDateName,
>> "dd-mmm-yy") & ".xls"
>> Range("A4").Select
>> 'save workbook with temp name to temp path
>> ActiveWorkbook.SaveAs Filename:=TempFilePath & TempFileName
>> ActiveWorkbook.Sheets("Move Request").Select
>>
>> 'format worksheet to send as attachment
>> ActiveSheet.Unprotect
>> Rows("41:43").Delete
>> ActiveSheet.Shapes("Rectangle 3").Delete
>> ActiveSheet.Shapes("Rectangle 2").Delete
>> Range("G5").Select
>> Range("A4").Select
>> ActiveSheet.Protect Password:="2j23"
>> 'send as attachment
>> ActiveWorkbook.SendMail Recipients:=MyRecipients, Subject:="MOVE
>> REQUEST for " & _
>> Range("B4").Value & " " & Range("F5").Value & " " &
>> Range("B5").Value & " requested: " &
>> Format(ActiveWorkbook.Sheets("Move Request").Range("F4").Value,
>> "mmm/dd/yy")
>> 'close without saving and delete temp file
>> ActiveWorkbook.Close SaveChanges:=False
>> Kill TempFilePath & TempFileName
>>
>> 'ThisWorkbook.Sheets("Move Request").Select
>> 'copy the data in the form
>> 'Range("A43:P43").Select
>> 'Selection.Copy
>>
>> 'ThisWorkbook.Sheets("Data Logs").Select
>> 'paste the data from the form into the table
>> 'lastrow = Range("A65536").End(xlUp).Row
>> 'Range("A" & lastrow + 1).Select
>> 'Selection.PasteSpecial Paste:=xlPasteValues
>> 'Range("A" & lastrow + 1).Select
>>
>> ThisWorkbook.Sheets("Move Request").Select
>> 'clear the data from the form
>> Call ClearData
>>
>> Sheets("EMAIL LIST").Select
>> ActiveSheet.Protect Password:="2j23"
>>
>> Sheets("Move Request").Select
>> ActiveSheet.Protect Password:="2j23"
>> Range("A1").Select
>>
>> ExitHere:
>> Exit Sub
>> ErrHandler:
>> MsgBox "An unexpected error occured, please check the data and try
>> again" & vbCrLf & _
>> Error$, vbCritical, "Unexpected Error"
>> Resume ExitHere
>> End Sub
>>
>>
>>
>>
>> Thanks for you help
>>

Your are making perfect sense. Save the blank worksheet with all the bells
and whistles (modules,buttons, etc ...). This will be a templet. Open this
file in the macro instead of creating a new workbook. Then add all the data
into the templet and save the file using the saveas (as in your code already)
under a different file name. The templet file never gets modified. You can
reuse this templet over and over again.

"Little Penny" wrote:

> The original spreadsheet is really a form that other people use to
> request information. When the form (originals spreadsheet) which is
> password protected and sits on a network drive is filled out it copies
> itself to a new workbook save itself with the name the users request
> and email itself to me.
>
> There is a macro button on the spreadsheet that once the use fills in
> all the information that activates this code.
>
> The way it is now the user just fills in the info and presses a
> button.
>
> I'm I making any sense
>
>
>
>
>
>
>
>
>
>
>
>
> On Sat, 15 Sep 2007 11:42:01 -0700, Joel
> <(E-Mail Removed)> wrote:
>
> >Penny: Instead of creating a new workbook, Open up an empty xls file that
> >contains module 2. Then copy the worksheet into opened file and saveas a new
> >filename as you have already done in your code.
> >
> >"Little Penny" wrote:
> >
> >> The code below copies a worksheet into a new book and then emails the
> >> new workbook. When the original worksheet is copied to a new workbook
> >> how can I modify my code to also copy Module5 to the new workbook?
> >>
> >> My Code:
> >>
> >>
> >>
> >> Sub MoveData()
> >> On Error GoTo ErrHandler
> >> Dim lastrow As Long, TempFilePath As String, TempFileName As String,
> >> lastemail As Byte
> >> Dim MyRecipients() As Variant, cel As Range, rg As Range, i As Long,
> >> response As Byte
> >> Dim TempCleanName As String, TempDateName As String
> >>
> >> response = MsgBox("Are you sure you want to process this
> >> request?", vbQuestion + vbOKCancel, "Confirm request process")
> >>
> >> If response = vbCancel Then
> >> End
> >> End If
> >>
> >> If Range("B4") = "" Or Range("B5") = "" Or Range("A8") = "" Or
> >> Range("B8") = "" Or Range("C8") = "" Or Range("D8") = "" Or
> >> Range("E8") = "" Or Range("A20") = "" Or Range("B22") = "" Then
> >> MsgBox "Form was not properly filled out, please check the
> >> values and try again.", vbInformation, "Missing Data"
> >> End
> >> End If
> >>
> >> Sheets("EMAIL LIST").Select
> >> Cells.Select
> >> ActiveSheet.Unprotect Password:="sj23"
> >> Range("A1").Select
> >> 'removes hyperlinks
> >> lastemail = Range("A65536").End(xlUp).Row
> >>
> >> Columns("A:A").Select
> >> Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
> >> Header:=xlGuess, _
> >> OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
> >> _
> >> DataOption1:=xlSortNormal
> >> Range("A1").Select
> >>
> >> Range("A2", "A" & lastemail).Select
> >> Selection.Hyperlinks.Delete
> >>
> >> Range("A1").Select
> >>
> >> 'creates array of email addy's for use with sendmail
> >> Set rg = Sheets("EMAIL LIST").Range([A2], [A65536].End(xlUp))
> >> ReDim MyRecipients(Application.CountA(rg))
> >> For Each cel In rg
> >> If cel <> "" Then
> >> MyRecipients(i) = cel
> >> i = i + 1
> >> End If
> >> Next
> >>
> >> 'copy worksheet to new workbook
> >> ThisWorkbook.Sheets("Move Request").Copy
> >> ActiveSheet.Unprotect Password:="2j23"
> >> 'get path for temp directory
> >> Range("H6").Select
> >> Selection.ClearContents
> >> Range("A1:G22").Select
> >> ActiveSheet.PageSetup.PrintArea = "$A$1:$G$23"
> >> Range("A5").Select
> >> Range("A1").Select
> >> ActiveWindow.View = xlPageBreakPreview
> >> ActiveWindow.Zoom = 100
> >> Cells.Select
> >> Selection.Locked = True
> >> Selection.FormulaHidden = False
> >>
> >> TempFilePath = Environ$("temp") & "\"
> >> 'generate filename
> >> 'calls function to parse out invalid name characters
> >> TempCleanName = CleanData(ActiveWorkbook.Sheets("Move
> >> Request").Range("B4").Value)
> >> TempDateName = ActiveWorkbook.Sheets("Move
> >> Request").Range("F4").Value
> >> TempFileName = TempCleanName & " " & Format(TempDateName,
> >> "dd-mmm-yy") & ".xls"
> >> Range("A4").Select
> >> 'save workbook with temp name to temp path
> >> ActiveWorkbook.SaveAs Filename:=TempFilePath & TempFileName
> >> ActiveWorkbook.Sheets("Move Request").Select
> >>
> >> 'format worksheet to send as attachment
> >> ActiveSheet.Unprotect
> >> Rows("41:43").Delete
> >> ActiveSheet.Shapes("Rectangle 3").Delete
> >> ActiveSheet.Shapes("Rectangle 2").Delete
> >> Range("G5").Select
> >> Range("A4").Select
> >> ActiveSheet.Protect Password:="2j23"
> >> 'send as attachment
> >> ActiveWorkbook.SendMail Recipients:=MyRecipients, Subject:="MOVE
> >> REQUEST for " & _
> >> Range("B4").Value & " " & Range("F5").Value & " " &
> >> Range("B5").Value & " requested: " &
> >> Format(ActiveWorkbook.Sheets("Move Request").Range("F4").Value,
> >> "mmm/dd/yy")
> >> 'close without saving and delete temp file
> >> ActiveWorkbook.Close SaveChanges:=False
> >> Kill TempFilePath & TempFileName
> >>
> >> 'ThisWorkbook.Sheets("Move Request").Select
> >> 'copy the data in the form
> >> 'Range("A43:P43").Select
> >> 'Selection.Copy
> >>
> >> 'ThisWorkbook.Sheets("Data Logs").Select
> >> 'paste the data from the form into the table
> >> 'lastrow = Range("A65536").End(xlUp).Row
> >> 'Range("A" & lastrow + 1).Select
> >> 'Selection.PasteSpecial Paste:=xlPasteValues
> >> 'Range("A" & lastrow + 1).Select
> >>
> >> ThisWorkbook.Sheets("Move Request").Select
> >> 'clear the data from the form
> >> Call ClearData
> >>
> >> Sheets("EMAIL LIST").Select
> >> ActiveSheet.Protect Password:="2j23"
> >>
> >> Sheets("Move Request").Select
> >> ActiveSheet.Protect Password:="2j23"
> >> Range("A1").Select
> >>
> >> ExitHere:
> >> Exit Sub
> >> ErrHandler:
> >> MsgBox "An unexpected error occured, please check the data and try
> >> again" & vbCrLf & _
> >> Error$, vbCritical, "Unexpected Error"
> >> Resume ExitHere
> >> End Sub
> >>
> >>
> >>
> >>
> >> Thanks for you help
> >>
>

Thanks for your guidance. I followed your suggestion and this is what
I came up with. It seems to work. Do you see anything in the code that
concerns you?


Thanks again


New Code:

Sub MoveData2()
Dim lastrow As Long, TempFilePath As String, TempFileName As String,
lastemail As Byte
Dim MyRecipients() As Variant, cel As Range, rg As Range, i As Long,
response As Byte
Dim TempCleanName As String, TempDateName As String


response = MsgBox("Are you sure you want to process this request?",
vbQuestion + vbOKCancel, "Confirm request process")

If response = vbCancel Then
End
End If

If Range("B4") = "" Or Range("B5") = "" Or Range("A8") = "" Or
Range("B8") = "" Or Range("C8") = "" Or Range("D8") = "" Or
Range("E8") = "" Or Range("A20") = "" Or Range("B22") = "" Then
MsgBox "Form was not properly filled out, please check the
values and try again.", vbInformation, "Missing Data"
End
End If

Sheets("EMAIL LIST").Select
ActiveSheet.Unprotect Password:="1234"
Cells.Select
Range("A1").Select
'removes hyperlinks
lastemail = Range("A65536").End(xlUp).Row

Columns("A:A").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
Range("A1").Select

Range("A2", "A" & lastemail).Select
Selection.Hyperlinks.Delete

Range("A1").Select

'creates array of email addy's for use with sendmail
Set rg = Sheets("EMAIL LIST").Range([A2], [A65536].End(xlUp))
ReDim MyRecipients(Application.CountA(rg))
For Each cel In rg
If cel <> "" Then
MyRecipients(i) = cel
i = i + 1
End If
Next


Sheets("Move Request").Select
Cells.Select
Selection.copy
Range("A1").Select
Workbooks.Open Filename:="C:\Move Request\Template.xlt"
Range("A1").Select
ActiveSheet.Paste

Range("H6").Select
Selection.ClearContents
Range("A1:G22").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$23"
Range("A5").Select
Range("A1").Select
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 100
Cells.Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Shapes("Rectangle 3").Delete
ActiveSheet.Shapes("Rectangle 2").Delete
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Move Request"
TempFilePath = Environ$("temp") & "\"
'generate filename
'calls function to parse out invalid name characters
TempCleanName = ActiveWorkbook.Sheets("Move
Request").Range("B4").Value
TempDateName = ActiveWorkbook.Sheets("Move
Request").Range("F4").Value
TempFileName = TempCleanName & " " & Format(TempDateName,
"dd-mmm-yy") & ".xls"
Range("A4").Select
'save workbook with temp name to temp path
ActiveWorkbook.SaveAs Filename:=TempFilePath & TempFileName
ActiveWorkbook.Sheets("Move Request").Select


ActiveWorkbook.SendMail Recipients:=MyRecipients, Subject:="MOVE
REQUEST for " & _
Range("B4").Value & " " & Range("F5").Value & " " &
Range("B5").Value & " requested: " &
Format(ActiveWorkbook.Sheets("Move Request").Range("F4").Value,
"mmm/dd/yy")
'close without saving and delete temp file
ActiveWorkbook.Close SaveChanges:=False
Kill TempFilePath & TempFileName




ThisWorkbook.Sheets("Move Request").Select
'clear the data from the form
Call ClearData

Sheets("EMAIL LIST").Select
ActiveSheet.Protect Password:="1234"

Sheets("Move Request").Select
ActiveSheet.Protect Password:="1234"
Range("A1").Select

ExitHere:
Exit Sub
ErrHandler:
MsgBox "An unexpected error occured, please check the data and try
again" & vbCrLf & _
Error$, vbCritical, "Unexpected Error"
Resume ExitHere


End Sub













On Sat, 15 Sep 2007 14:14:15 -0700, Joel
<(E-Mail Removed)> wrote:

>Your are making perfect sense. Save the blank worksheet with all the bells
>and whistles (modules,buttons, etc ...). This will be a templet. Open this
>file in the macro instead of creating a new workbook. Then add all the data
>into the templet and save the file using the saveas (as in your code already)
>under a different file name. The templet file never gets modified. You can
>reuse this templet over and over again.
>
>"Little Penny" wrote:
>
>> The original spreadsheet is really a form that other people use to
>> request information. When the form (originals spreadsheet) which is
>> password protected and sits on a network drive is filled out it copies
>> itself to a new workbook save itself with the name the users request
>> and email itself to me.
>>
>> There is a macro button on the spreadsheet that once the use fills in
>> all the information that activates this code.
>>
>> The way it is now the user just fills in the info and presses a
>> button.
>>
>> I'm I making any sense
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>> On Sat, 15 Sep 2007 11:42:01 -0700, Joel
>> <(E-Mail Removed)> wrote:
>>
>> >Penny: Instead of creating a new workbook, Open up an empty xls file that
>> >contains module 2. Then copy the worksheet into opened file and saveas a new
>> >filename as you have already done in your code.
>> >
>> >"Little Penny" wrote:
>> >
>> >> The code below copies a worksheet into a new book and then emails the
>> >> new workbook. When the original worksheet is copied to a new workbook
>> >> how can I modify my code to also copy Module5 to the new workbook?
>> >>
>> >> My Code:
>> >>
>> >>
>> >>
>> >> Sub MoveData()
>> >> On Error GoTo ErrHandler
>> >> Dim lastrow As Long, TempFilePath As String, TempFileName As String,
>> >> lastemail As Byte
>> >> Dim MyRecipients() As Variant, cel As Range, rg As Range, i As Long,
>> >> response As Byte
>> >> Dim TempCleanName As String, TempDateName As String
>> >>
>> >> response = MsgBox("Are you sure you want to process this
>> >> request?", vbQuestion + vbOKCancel, "Confirm request process")
>> >>
>> >> If response = vbCancel Then
>> >> End
>> >> End If
>> >>
>> >> If Range("B4") = "" Or Range("B5") = "" Or Range("A8") = "" Or
>> >> Range("B8") = "" Or Range("C8") = "" Or Range("D8") = "" Or
>> >> Range("E8") = "" Or Range("A20") = "" Or Range("B22") = "" Then
>> >> MsgBox "Form was not properly filled out, please check the
>> >> values and try again.", vbInformation, "Missing Data"
>> >> End
>> >> End If
>> >>
>> >> Sheets("EMAIL LIST").Select
>> >> Cells.Select
>> >> ActiveSheet.Unprotect Password:="sj23"
>> >> Range("A1").Select
>> >> 'removes hyperlinks
>> >> lastemail = Range("A65536").End(xlUp).Row
>> >>
>> >> Columns("A:A").Select
>> >> Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
>> >> Header:=xlGuess, _
>> >> OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
>> >> _
>> >> DataOption1:=xlSortNormal
>> >> Range("A1").Select
>> >>
>> >> Range("A2", "A" & lastemail).Select
>> >> Selection.Hyperlinks.Delete
>> >>
>> >> Range("A1").Select
>> >>
>> >> 'creates array of email addy's for use with sendmail
>> >> Set rg = Sheets("EMAIL LIST").Range([A2], [A65536].End(xlUp))
>> >> ReDim MyRecipients(Application.CountA(rg))
>> >> For Each cel In rg
>> >> If cel <> "" Then
>> >> MyRecipients(i) = cel
>> >> i = i + 1
>> >> End If
>> >> Next
>> >>
>> >> 'copy worksheet to new workbook
>> >> ThisWorkbook.Sheets("Move Request").Copy
>> >> ActiveSheet.Unprotect Password:="2j23"
>> >> 'get path for temp directory
>> >> Range("H6").Select
>> >> Selection.ClearContents
>> >> Range("A1:G22").Select
>> >> ActiveSheet.PageSetup.PrintArea = "$A$1:$G$23"
>> >> Range("A5").Select
>> >> Range("A1").Select
>> >> ActiveWindow.View = xlPageBreakPreview
>> >> ActiveWindow.Zoom = 100
>> >> Cells.Select
>> >> Selection.Locked = True
>> >> Selection.FormulaHidden = False
>> >>
>> >> TempFilePath = Environ$("temp") & "\"
>> >> 'generate filename
>> >> 'calls function to parse out invalid name characters
>> >> TempCleanName = CleanData(ActiveWorkbook.Sheets("Move
>> >> Request").Range("B4").Value)
>> >> TempDateName = ActiveWorkbook.Sheets("Move
>> >> Request").Range("F4").Value
>> >> TempFileName = TempCleanName & " " & Format(TempDateName,
>> >> "dd-mmm-yy") & ".xls"
>> >> Range("A4").Select
>> >> 'save workbook with temp name to temp path
>> >> ActiveWorkbook.SaveAs Filename:=TempFilePath & TempFileName
>> >> ActiveWorkbook.Sheets("Move Request").Select
>> >>
>> >> 'format worksheet to send as attachment
>> >> ActiveSheet.Unprotect
>> >> Rows("41:43").Delete
>> >> ActiveSheet.Shapes("Rectangle 3").Delete
>> >> ActiveSheet.Shapes("Rectangle 2").Delete
>> >> Range("G5").Select
>> >> Range("A4").Select
>> >> ActiveSheet.Protect Password:="2j23"
>> >> 'send as attachment
>> >> ActiveWorkbook.SendMail Recipients:=MyRecipients, Subject:="MOVE
>> >> REQUEST for " & _
>> >> Range("B4").Value & " " & Range("F5").Value & " " &
>> >> Range("B5").Value & " requested: " &
>> >> Format(ActiveWorkbook.Sheets("Move Request").Range("F4").Value,
>> >> "mmm/dd/yy")
>> >> 'close without saving and delete temp file
>> >> ActiveWorkbook.Close SaveChanges:=False
>> >> Kill TempFilePath & TempFileName
>> >>
>> >> 'ThisWorkbook.Sheets("Move Request").Select
>> >> 'copy the data in the form
>> >> 'Range("A43:P43").Select
>> >> 'Selection.Copy
>> >>
>> >> 'ThisWorkbook.Sheets("Data Logs").Select
>> >> 'paste the data from the form into the table
>> >> 'lastrow = Range("A65536").End(xlUp).Row
>> >> 'Range("A" & lastrow + 1).Select
>> >> 'Selection.PasteSpecial Paste:=xlPasteValues
>> >> 'Range("A" & lastrow + 1).Select
>> >>
>> >> ThisWorkbook.Sheets("Move Request").Select
>> >> 'clear the data from the form
>> >> Call ClearData
>> >>
>> >> Sheets("EMAIL LIST").Select
>> >> ActiveSheet.Protect Password:="2j23"
>> >>
>> >> Sheets("Move Request").Select
>> >> ActiveSheet.Protect Password:="2j23"
>> >> Range("A1").Select
>> >>
>> >> ExitHere:
>> >> Exit Sub
>> >> ErrHandler:
>> >> MsgBox "An unexpected error occured, please check the data and try
>> >> again" & vbCrLf & _
>> >> Error$, vbCritical, "Unexpected Error"
>> >> Resume ExitHere
>> >> End Sub
>> >>
>> >>
>> >>
>> >>
>> >> Thanks for you help
>> >>
>>