Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Rename active sheet to contents of specific cell
The following code sends the active sheet to a group of individuals
automatically via e-mail. . Two of the individuals will always receive the e-mail, the third would depend upon which individual requested the data, the third individuals name is called from a lookup table and the corresponding e-mail address is placed into cell I10. What I'd like to happen is that the active sheet is renamed to the reference no. in cell B6, this sheet is then e-mailed to the recipients. The macro works great with the exception of the renaming of the sheet, is their a simple solution that can remedy this. Thanks Burl Sub Rectangle15_Click() Dim sh As Worksheet Dim wb As Workbook Dim strdate As String Dim MyArrIndex As Long Dim E_Mail_Count As Long Dim cell As Range Dim MyArr() As String Application.ScreenUpdating = False Worksheets("QuoteForm").Activate Range("I10").Select Selection.Copy Range("L2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False For Each sh In ThisWorkbook.Worksheets If sh.Range("L1").Value Like "?*@?*.?*" Then strdate = Format(Now, "dd-mm-yy h-mm-ss") E_Mail_Count = sh.Columns("L").Cells.SpecialCells(xlCellTypeConst ants).Count ReDim MyArr(1 To E_Mail_Count) MyArrIndex = 1 For Each cell In sh.Columns("L").Cells.SpecialCells(xlCellTypeConst ants) If cell Like "*@*" Then MyArr(MyArrIndex) = cell.Value MyArrIndex = MyArrIndex + 1 End If Next ReDim Preserve MyArr(1 To MyArrIndex) sh.Copy Set wb = ActiveWorkbook ActiveSheet.Name = Range("b6") With wb .SaveAs " " & sh.Name & " " & strdate & ".xls" .SendMail MyArr, _ "New Quote" .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End If Next sh Application.ScreenUpdating = True Worksheets("Quote Data Entry").Activate End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Rename active sheet to contents of specific cell
I fixed it.......
By changing the following:- ActiveSheet.Name = Range("b6") to sh.name = Range("b6") Thanks Burl |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Rename active sheet to contents of specific cell
Maybe I still have a problem.....
Renaming the sheet according to the contents of cell "B6" may not be the best solution. The original name of the sheet I need to maintain (I use the original sheet name to make it the active sheet at the begining of the macro, renaming the sheet would only complicate things later). Could I perhaps save the sheet using the contents of cell "B6" as the name of the file along with the strdate instead of renaming the sheet. Thanks Burl sh.Copy Set wb = ActiveWorkbook ActiveSheet.Name = Range("b6") With wb .SaveAs " " & sh.Name & " " & strdate & ".xls" .SendMail MyArr, _ "New Quote" .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Rename active sheet to contents of specific cell
Okay, now it's working fine...
I added the renaming of the sheet to the next to last step in the macro, I'm thinking that where I had previously put it, it was causing some problems. The finish code is below Sub Rectangle15_Click() Dim sh As Worksheet Dim wb As Workbook Dim strdate As String Dim MyArrIndex As Long Dim E_Mail_Count As Long Dim cell As Range Dim MyArr() As String Application.ScreenUpdating = False Worksheets("QuoteForm").Activate Range("I10").Select Selection.Copy Range("L2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False For Each sh In ThisWorkbook.Worksheets If sh.Range("L1").Value Like "?*@?*.?*" Then strdate = Format(Now, "dd-mm-yy h-mm-ss") E_Mail_Count = sh.Columns("L").Cells.SpecialCells(xlCellTypeConst ants).Count ReDim MyArr(1 To E_Mail_Count) MyArrIndex = 1 For Each cell In sh.Columns("L").Cells.SpecialCells(xlCellTypeConst ants) If cell Like "*@*" Then MyArr(MyArrIndex) = cell.Value MyArrIndex = MyArrIndex + 1 End If Next ReDim Preserve MyArr(1 To MyArrIndex) sh.Copy Set wb = ActiveWorkbook sh.Name = Range("b6") With wb .SaveAs " " & sh.Name & " " & strdate & ".xls" .SendMail MyArr, _ "New Quote" .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End If Next sh Application.ScreenUpdating = True ActiveSheet.Name = "QuoteForm" Worksheets("Quote Data Entry").Activate End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do I automatically rename a sheet with the contents of a cell. | Excel Discussion (Misc queries) | |||
using VBA to rename active sheet | Excel Programming | |||
Add sheet and rename with cell contents | Excel Programming | |||
Rename active sheet | Excel Programming | |||
Rename Active Sheet | Excel Programming |