Copy Module to new Workbook
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
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
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
|