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

ExitHe
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