Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Copy Module to new Workbook
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 64
Default Copy Module to new Workbook
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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Copy Module to new Workbook
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

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 64
Default 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

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Copy Module to new Workbook
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
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


Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 64
Default Copy Module to new Workbook
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

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













On Sat, 15 Sep 2007 14:14:15 -0700, Joel
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
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


Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
move module from a workbook to new workbook via VBA Stefi Excel Programming 2 March 22nd 07 11:17 AM
How to copy module form one workbook to another deepakmehta[_7_] Excel Programming 4 May 8th 06 10:03 PM
Run worksheet module code from workbook module? keithb Excel Programming 1 August 14th 05 04:04 AM
Automatically Delete WorkBook 2 modules by using Workbook 1 module ddiicc Excel Programming 5 July 27th 05 12:53 PM
Copy VBA Module and Form from Workbook to another workbook topaiva Excel Programming 1 November 25th 04 03:47 PM


All times are GMT +1. The time now is 12:06 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement