Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I select the 2nd sheet from the Right in this code Q
The code below e-mail's (thanks to Ron de Bruin) out two sheets
"Summary Report" and a second variable sheet, which below shows 26/08/07, but this changes every week, thus I'm looking to place the appropriate code below that would select the 2nd sheet to the right of "Summary Report", as the sheet I will want to include will always be in this location (but its name will change) Thanks Sub Mail_New_Version() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 'We exit the sub when your answer is NO in the security dialog that you only 'see when you copy a sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With 'Change all cells in the worksheets to values if you want For Each sh In Destwb.Worksheets sh.Select With sh.UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd- mmm-yy h-mm") ActiveWindow.TabRatio = 0.908 ClearMacroButtons Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) For Each cell In ThisWorkbook.Sheets("Summary Report") _ .Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts) If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next strto = Left(strto, Len(strto) - 1) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = strto .CC = "" .BCC = "" .Subject = ThisWorkbook.Sheets("Summary Report").Range("BB1").Value .Body = "" .Attachments.Add Destwb.FullName .ReadReceiptRequested = False .Importance = 1 .Send End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I select the 2nd sheet from the Right in this code Q
Something to start with
Sub getsheet() n = Worksheets.Count Worksheets(n - 2).Select End Sub best wishes -- Bernard V Liengme Microsoft Excel MVP www.stfx.ca/people/bliengme remove caps from email "Sean" wrote in message ups.com... The code below e-mail's (thanks to Ron de Bruin) out two sheets "Summary Report" and a second variable sheet, which below shows 26/08/07, but this changes every week, thus I'm looking to place the appropriate code below that would select the 2nd sheet to the right of "Summary Report", as the sheet I will want to include will always be in this location (but its name will change) Thanks Sub Mail_New_Version() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 'We exit the sub when your answer is NO in the security dialog that you only 'see when you copy a sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With 'Change all cells in the worksheets to values if you want For Each sh In Destwb.Worksheets sh.Select With sh.UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd- mmm-yy h-mm") ActiveWindow.TabRatio = 0.908 ClearMacroButtons Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) For Each cell In ThisWorkbook.Sheets("Summary Report") _ .Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts) If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next strto = Left(strto, Len(strto) - 1) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = strto .CC = "" .BCC = "" .Subject = ThisWorkbook.Sheets("Summary Report").Range("BB1").Value .Body = "" .Attachments.Add Destwb.FullName .ReadReceiptRequested = False .Importance = 1 .Send End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I select the 2nd sheet from the Right in this code Q
On Aug 26, 1:59 pm, "Bernard Liengme"
wrote: Something to start with Sub getsheet() n = Worksheets.Count Worksheets(n - 2).Select End Sub best wishes -- Bernard V Liengme Microsoft Excel MVPwww.stfx.ca/people/bliengme remove caps from email "Sean" wrote in message ups.com... The code below e-mail's (thanks to Ron de Bruin) out two sheets "Summary Report" and a second variable sheet, which below shows 26/08/07, but this changes every week, thus I'm looking to place the appropriate code below that would select the 2nd sheet to the right of "Summary Report", as the sheet I will want to include will always be in this location (but its name will change) Thanks Sub Mail_New_Version() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 'We exit the sub when your answer is NO in the security dialog that you only 'see when you copy a sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With 'Change all cells in the worksheets to values if you want For Each sh In Destwb.Worksheets sh.Select With sh.UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd- mmm-yy h-mm") ActiveWindow.TabRatio = 0.908 ClearMacroButtons Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) For Each cell In ThisWorkbook.Sheets("Summary Report") _ .Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts) If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next strto = Left(strto, Len(strto) - 1) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = strto .CC = "" .BCC = "" .Subject = ThisWorkbook.Sheets("Summary Report").Range("BB1").Value .Body = "" .Attachments.Add Destwb.FullName .ReadReceiptRequested = False .Importance = 1 .Send End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub- Hide quoted text - - Show quoted text - Thanks Bernard, but how would I incorporate it within this critical line - Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I select the 2nd sheet from the Right in this code Q
Sub gothere()
i = 0 For Each sh In Worksheets If sh.Name = "Summary Reports" Then Exit For End If i = i + 1 Next Sheets(i + 3).Activate End Sub -- Gary''s Student - gsnu200740 "Sean" wrote: The code below e-mail's (thanks to Ron de Bruin) out two sheets "Summary Report" and a second variable sheet, which below shows 26/08/07, but this changes every week, thus I'm looking to place the appropriate code below that would select the 2nd sheet to the right of "Summary Report", as the sheet I will want to include will always be in this location (but its name will change) Thanks Sub Mail_New_Version() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 'We exit the sub when your answer is NO in the security dialog that you only 'see when you copy a sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With 'Change all cells in the worksheets to values if you want For Each sh In Destwb.Worksheets sh.Select With sh.UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd- mmm-yy h-mm") ActiveWindow.TabRatio = 0.908 ClearMacroButtons Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) For Each cell In ThisWorkbook.Sheets("Summary Report") _ .Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts) If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next strto = Left(strto, Len(strto) - 1) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = strto .CC = "" .BCC = "" .Subject = ThisWorkbook.Sheets("Summary Report").Range("BB1").Value .Body = "" .Attachments.Add Destwb.FullName .ReadReceiptRequested = False .Importance = 1 .Send End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I select the 2nd sheet from the Right in this code Q
Sean, this is untested but it should give you an idea of how to approach the
problem. I have incorporated GS's code into yours. Sub Mail_New_Version() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet Dim myNdx As Long With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook i = 0 For Each sh In Worksheets If sh.Name = "Summary Reports" Then Exit For End If i = i + 1 Next myNdx = Sheets(i + 3) 'Copy the sheets to a new workbook ' Replace the date reference with the sheet index obtained above. Sourcewb.Sheets(Array("Summary Report", Sheets(myNdx))).Copy Set Destwb = ActiveWorkbook "Sean" wrote: The code below e-mail's (thanks to Ron de Bruin) out two sheets "Summary Report" and a second variable sheet, which below shows 26/08/07, but this changes every week, thus I'm looking to place the appropriate code below that would select the 2nd sheet to the right of "Summary Report", as the sheet I will want to include will always be in this location (but its name will change) Thanks Sub Mail_New_Version() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 'We exit the sub when your answer is NO in the security dialog that you only 'see when you copy a sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With 'Change all cells in the worksheets to values if you want For Each sh In Destwb.Worksheets sh.Select With sh.UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd- mmm-yy h-mm") ActiveWindow.TabRatio = 0.908 ClearMacroButtons Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) For Each cell In ThisWorkbook.Sheets("Summary Report") _ .Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts) If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next strto = Left(strto, Len(strto) - 1) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = strto .CC = "" .BCC = "" .Subject = ThisWorkbook.Sheets("Summary Report").Range("BB1").Value .Body = "" .Attachments.Add Destwb.FullName .ReadReceiptRequested = False .Importance = 1 .Send End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I select the 2nd sheet from the Right in this code Q
What he is saying is to use the sheet index number to find the 2nd sheet to
the right of a known sheet. The sheet index number keeps track of the worksheet positions as they appear in the workbook, counting tabs from left to right. If "Summary Report" is the first tab, then Worksheets("Summary Report").Index = 1. The second sheet to the right would be Worksheets(1+2). In your code, dim 2 more variables: Dim i As Integer 'sheet index number Dim wsVar As String 'name of 2nd sheet i = Worksheets("Summary Report").Index wsVar = Worksheets(i + 2).Name Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy This is untested, but should get you close. The syntax for Sheets(Array() may be an issue with the variable, post back if you can't get it to work. Mike F "Sean" wrote in message oups.com... On Aug 26, 1:59 pm, "Bernard Liengme" wrote: Something to start with Sub getsheet() n = Worksheets.Count Worksheets(n - 2).Select End Sub best wishes -- Bernard V Liengme Microsoft Excel MVPwww.stfx.ca/people/bliengme remove caps from email "Sean" wrote in message ups.com... The code below e-mail's (thanks to Ron de Bruin) out two sheets "Summary Report" and a second variable sheet, which below shows 26/08/07, but this changes every week, thus I'm looking to place the appropriate code below that would select the 2nd sheet to the right of "Summary Report", as the sheet I will want to include will always be in this location (but its name will change) Thanks Sub Mail_New_Version() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 'We exit the sub when your answer is NO in the security dialog that you only 'see when you copy a sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With 'Change all cells in the worksheets to values if you want For Each sh In Destwb.Worksheets sh.Select With sh.UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd- mmm-yy h-mm") ActiveWindow.TabRatio = 0.908 ClearMacroButtons Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) For Each cell In ThisWorkbook.Sheets("Summary Report") _ .Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts) If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next strto = Left(strto, Len(strto) - 1) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = strto .CC = "" .BCC = "" .Subject = ThisWorkbook.Sheets("Summary Report").Range("BB1").Value .Body = "" .Attachments.Add Destwb.FullName .ReadReceiptRequested = False .Importance = 1 .Send End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub- Hide quoted text - - Show quoted text - Thanks Bernard, but how would I incorporate it within this critical line - Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I select the 2nd sheet from the Right in this code Q
On Aug 26, 3:38 pm, "Mike Fogleman"
wrote: What he is saying is to use the sheet index number to find the 2nd sheet to the right of a known sheet. The sheet index number keeps track of the worksheet positions as they appear in the workbook, counting tabs from left to right. If "Summary Report" is the first tab, then Worksheets("Summary Report").Index = 1. The second sheet to the right would be Worksheets(1+2). In your code, dim 2 more variables: Dim i As Integer 'sheet index number Dim wsVar As String 'name of 2nd sheet i = Worksheets("Summary Report").Index wsVar = Worksheets(i + 2).Name Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy This is untested, but should get you close. The syntax for Sheets(Array() may be an issue with the variable, post back if you can't get it to work. Mike F "Sean" wrote in message oups.com... On Aug 26, 1:59 pm, "Bernard Liengme" wrote: Something to start with Sub getsheet() n = Worksheets.Count Worksheets(n - 2).Select End Sub best wishes -- Bernard V Liengme Microsoft Excel MVPwww.stfx.ca/people/bliengme remove caps from email "Sean" wrote in message roups.com... The code below e-mail's (thanks to Ron de Bruin) out two sheets "Summary Report" and a second variable sheet, which below shows 26/08/07, but this changes every week, thus I'm looking to place the appropriate code below that would select the 2nd sheet to the right of "Summary Report", as the sheet I will want to include will always be in this location (but its name will change) Thanks Sub Mail_New_Version() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 'We exit the sub when your answer is NO in the security dialog that you only 'see when you copy a sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With 'Change all cells in the worksheets to values if you want For Each sh In Destwb.Worksheets sh.Select With sh.UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd- mmm-yy h-mm") ActiveWindow.TabRatio = 0.908 ClearMacroButtons Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) For Each cell In ThisWorkbook.Sheets("Summary Report") _ .Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts) If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next strto = Left(strto, Len(strto) - 1) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = strto .CC = "" .BCC = "" .Subject = ThisWorkbook.Sheets("Summary Report").Range("BB1").Value .Body = "" .Attachments.Add Destwb.FullName .ReadReceiptRequested = False .Importance = 1 .Send End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub- Hide quoted text - - Show quoted text - Thanks Bernard, but how would I incorporate it within this critical line - Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook- Hide quoted text - - Show quoted text - Thanks Mike I'm getting debug subscript out of range on line "Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy" and I've changed my code to below Set Sourcewb = ActiveWorkbook i = Worksheets("Summary Report").Index wsVar = Worksheets(i + 2).Name Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy Set Destwb = ActiveWorkbook |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I select the 2nd sheet from the Right in this code Q
Since wsVar is a string, try it without the quotes around it:
Sourcewb.Sheets(Array("Summary Report", wsVar)).Copy Mike F "Sean" wrote in message ups.com... On Aug 26, 3:38 pm, "Mike Fogleman" wrote: What he is saying is to use the sheet index number to find the 2nd sheet to the right of a known sheet. The sheet index number keeps track of the worksheet positions as they appear in the workbook, counting tabs from left to right. If "Summary Report" is the first tab, then Worksheets("Summary Report").Index = 1. The second sheet to the right would be Worksheets(1+2). In your code, dim 2 more variables: Dim i As Integer 'sheet index number Dim wsVar As String 'name of 2nd sheet i = Worksheets("Summary Report").Index wsVar = Worksheets(i + 2).Name Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy This is untested, but should get you close. The syntax for Sheets(Array() may be an issue with the variable, post back if you can't get it to work. Mike F "Sean" wrote in message oups.com... On Aug 26, 1:59 pm, "Bernard Liengme" wrote: Something to start with Sub getsheet() n = Worksheets.Count Worksheets(n - 2).Select End Sub best wishes -- Bernard V Liengme Microsoft Excel MVPwww.stfx.ca/people/bliengme remove caps from email "Sean" wrote in message roups.com... The code below e-mail's (thanks to Ron de Bruin) out two sheets "Summary Report" and a second variable sheet, which below shows 26/08/07, but this changes every week, thus I'm looking to place the appropriate code below that would select the 2nd sheet to the right of "Summary Report", as the sheet I will want to include will always be in this location (but its name will change) Thanks Sub Mail_New_Version() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 'We exit the sub when your answer is NO in the security dialog that you only 'see when you copy a sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With 'Change all cells in the worksheets to values if you want For Each sh In Destwb.Worksheets sh.Select With sh.UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd- mmm-yy h-mm") ActiveWindow.TabRatio = 0.908 ClearMacroButtons Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) For Each cell In ThisWorkbook.Sheets("Summary Report") _ .Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts) If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next strto = Left(strto, Len(strto) - 1) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = strto .CC = "" .BCC = "" .Subject = ThisWorkbook.Sheets("Summary Report").Range("BB1").Value .Body = "" .Attachments.Add Destwb.FullName .ReadReceiptRequested = False .Importance = 1 .Send End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub- Hide quoted text - - Show quoted text - Thanks Bernard, but how would I incorporate it within this critical line - Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook- Hide quoted text - - Show quoted text - Thanks Mike I'm getting debug subscript out of range on line "Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy" and I've changed my code to below Set Sourcewb = ActiveWorkbook i = Worksheets("Summary Report").Index wsVar = Worksheets(i + 2).Name Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy Set Destwb = ActiveWorkbook |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I select the 2nd sheet from the Right in this code Q
On Aug 26, 5:26 pm, "Mike Fogleman"
wrote: Since wsVar is a string, try it without the quotes around it: Sourcewb.Sheets(Array("Summary Report", wsVar)).Copy Mike F "Sean" wrote in message ups.com... On Aug 26, 3:38 pm, "Mike Fogleman" wrote: What he is saying is to use the sheet index number to find the 2nd sheet to the right of a known sheet. The sheet index number keeps track of the worksheet positions as they appear in the workbook, counting tabs from left to right. If "Summary Report" is the first tab, then Worksheets("Summary Report").Index = 1. The second sheet to the right would be Worksheets(1+2). In your code, dim 2 more variables: Dim i As Integer 'sheet index number Dim wsVar As String 'name of 2nd sheet i = Worksheets("Summary Report").Index wsVar = Worksheets(i + 2).Name Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy This is untested, but should get you close. The syntax for Sheets(Array() may be an issue with the variable, post back if you can't get it to work. Mike F "Sean" wrote in message groups.com... On Aug 26, 1:59 pm, "Bernard Liengme" wrote: Something to start with Sub getsheet() n = Worksheets.Count Worksheets(n - 2).Select End Sub best wishes -- Bernard V Liengme Microsoft Excel MVPwww.stfx.ca/people/bliengme remove caps from email "Sean" wrote in message roups.com... The code below e-mail's (thanks to Ron de Bruin) out two sheets "Summary Report" and a second variable sheet, which below shows 26/08/07, but this changes every week, thus I'm looking to place the appropriate code below that would select the 2nd sheet to the right of "Summary Report", as the sheet I will want to include will always be in this location (but its name will change) Thanks Sub Mail_New_Version() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 'We exit the sub when your answer is NO in the security dialog that you only 'see when you copy a sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With 'Change all cells in the worksheets to values if you want For Each sh In Destwb.Worksheets sh.Select With sh.UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd- mmm-yy h-mm") ActiveWindow.TabRatio = 0.908 ClearMacroButtons Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) For Each cell In ThisWorkbook.Sheets("Summary Report") _ .Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts) If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next strto = Left(strto, Len(strto) - 1) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = strto .CC = "" .BCC = "" .Subject = ThisWorkbook.Sheets("Summary Report").Range("BB1").Value .Body = "" .Attachments.Add Destwb.FullName .ReadReceiptRequested = False .Importance = 1 .Send End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub- Hide quoted text - - Show quoted text - Thanks Bernard, but how would I incorporate it within this critical line - Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook- Hide quoted text - - Show quoted text - Thanks Mike I'm getting debug subscript out of range on line "Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy" and I've changed my code to below Set Sourcewb = ActiveWorkbook i = Worksheets("Summary Report").Index wsVar = Worksheets(i + 2).Name Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy Set Destwb = ActiveWorkbook- Hide quoted text - - Show quoted text - Bingo, thanks Mike that works. One final Q which you might be able to assist on is I use the code below to delete all macro buttons from the sheet I mail out, but how do I include the name of the 'variable sheet' if its name changes all the time? Sub ClearMacroButtons() On Error Resume Next Sheets("26/08/07").Select ActiveSheet.DrawingObjects.Visible = True ActiveSheet.DrawingObjects.Delete Sheets("Summay Report").Select ActiveSheet.DrawingObjects.Visible = True ActiveSheet.DrawingObjects.Delete On Error GoTo 0 End Sub |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I select the 2nd sheet from the Right in this code Q
Again you need to reference the 2nd sheet to the right, the easiest by using
the Index number. In this case only the number need be used, where as in the last case, the function Sheets(Array()) needed a String. Sub ClearMacroButtons() Dim i As Integer, ws As Worksheet i = Worksheets("Summary Report").Index Set ws = Worksheets(i + 2) On Error Resume Next With ws '.Select not needed .DrawingObjects.Visible = True .DrawingObjects.Delete End With Set ws = Worksheets( i ) With ws .DrawingObjects.Visible = True .DrawingObjects.Delete End With On Error GoTo 0 End Sub Mike F "Sean" wrote in message ps.com... On Aug 26, 5:26 pm, "Mike Fogleman" wrote: Since wsVar is a string, try it without the quotes around it: Sourcewb.Sheets(Array("Summary Report", wsVar)).Copy Mike F "Sean" wrote in message ups.com... On Aug 26, 3:38 pm, "Mike Fogleman" wrote: What he is saying is to use the sheet index number to find the 2nd sheet to the right of a known sheet. The sheet index number keeps track of the worksheet positions as they appear in the workbook, counting tabs from left to right. If "Summary Report" is the first tab, then Worksheets("Summary Report").Index = 1. The second sheet to the right would be Worksheets(1+2). In your code, dim 2 more variables: Dim i As Integer 'sheet index number Dim wsVar As String 'name of 2nd sheet i = Worksheets("Summary Report").Index wsVar = Worksheets(i + 2).Name Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy This is untested, but should get you close. The syntax for Sheets(Array() may be an issue with the variable, post back if you can't get it to work. Mike F "Sean" wrote in message groups.com... On Aug 26, 1:59 pm, "Bernard Liengme" wrote: Something to start with Sub getsheet() n = Worksheets.Count Worksheets(n - 2).Select End Sub best wishes -- Bernard V Liengme Microsoft Excel MVPwww.stfx.ca/people/bliengme remove caps from email "Sean" wrote in message roups.com... The code below e-mail's (thanks to Ron de Bruin) out two sheets "Summary Report" and a second variable sheet, which below shows 26/08/07, but this changes every week, thus I'm looking to place the appropriate code below that would select the 2nd sheet to the right of "Summary Report", as the sheet I will want to include will always be in this location (but its name will change) Thanks Sub Mail_New_Version() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 'We exit the sub when your answer is NO in the security dialog that you only 'see when you copy a sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With 'Change all cells in the worksheets to values if you want For Each sh In Destwb.Worksheets sh.Select With sh.UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False Destwb.Worksheets(1).Select Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd- mmm-yy h-mm") ActiveWindow.TabRatio = 0.908 ClearMacroButtons Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) For Each cell In ThisWorkbook.Sheets("Summary Report") _ .Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts) If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next strto = Left(strto, Len(strto) - 1) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = strto .CC = "" .BCC = "" .Subject = ThisWorkbook.Sheets("Summary Report").Range("BB1").Value .Body = "" .Attachments.Add Destwb.FullName .ReadReceiptRequested = False .Importance = 1 .Send End With On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub- Hide quoted text - - Show quoted text - Thanks Bernard, but how would I incorporate it within this critical line - Sourcewb.Sheets(Array("Summary Report", "26/08/07")).Copy Set Destwb = ActiveWorkbook- Hide quoted text - - Show quoted text - Thanks Mike I'm getting debug subscript out of range on line "Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy" and I've changed my code to below Set Sourcewb = ActiveWorkbook i = Worksheets("Summary Report").Index wsVar = Worksheets(i + 2).Name Sourcewb.Sheets(Array("Summary Report", "& wsVar &")).Copy Set Destwb = ActiveWorkbook- Hide quoted text - - Show quoted text - Bingo, thanks Mike that works. One final Q which you might be able to assist on is I use the code below to delete all macro buttons from the sheet I mail out, but how do I include the name of the 'variable sheet' if its name changes all the time? Sub ClearMacroButtons() On Error Resume Next Sheets("26/08/07").Select ActiveSheet.DrawingObjects.Visible = True ActiveSheet.DrawingObjects.Delete Sheets("Summay Report").Select ActiveSheet.DrawingObjects.Visible = True ActiveSheet.DrawingObjects.Delete On Error GoTo 0 End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Range("Reset Sheet!F13").Select Makes VBA Code Fail | Excel Programming | |||
code to select first sheet | Excel Programming | |||
Select sheet with VB code | Excel Discussion (Misc queries) | |||
how can i select all the cells with same color on a sheet if there are multipale colors by vba code | Charts and Charting in Excel |