Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies. Only from Platform Scholar.
Option Explicit Public v_Wks1Name As String Public v_Wks2Name As String Sub M_Email_AppvlReqLOJ() '//Creates two stand-alone to email// With Application .ScreenUpdating = False .EnableEvents = False End With '//Generate single file with X-many Worksheets// '//Send to M_CreateMultiWksFile sub any number of Worksheets// v_Wks1Name = "RequirementSummary" v_Wks2Name = "Reviewer1" Call M_CreateMultiWksFile(v_Wks1Name, v_Wks2Name) Worksheets("Approvals").Select '//in original workbook// [Rd_Reviewer1].Select With Application .EnableEvents = True End With End Sub Sub M_CreateMultiWksFile(v_Wks1Name, v_Wks2Name) '//This sub will create and save an Excel file from existing Worksheets in another Workbook// '//?How do I make it accept various numbers of worksheet names, not just two?// '//Load record data for Key: Location + ReqmtName + StartDateDDMMYY // '//This will be used to name the file// Dim v_FileExtStr As String Dim FileFormatNum As Long Dim wkbRCOT As Workbook Dim wkbDest As Workbook Dim TempFilePath As String Dim TempFileName As String Dim sh As Worksheet Dim TheActiveWindow As Window Dim TempWindow As Window Dim i As Long Dim iCount As Long Dim j As Long Dim jSheets As Long Dim v_Location As String Dim v_ReqName As String Dim v_DateYYMMDD As String Dim v_TimeStamp As String '//Get contents of named ranges in original workbook// '//these will be used to name the newly created file// v_Location = [db1_Rde_Location].Value v_ReqName = [db1_Rde_RequirementName].Value v_DateYYMMDD = [db1_StartDateYYMMDD].Value '//ActiveWorkbook is source file. Set wkbRCOT = ActiveWorkbook '//Copy Sheets into a new workbook called wbkNew// Sheets(Array(v_Wks1Name, v_Wks2Name)).Copy Set wkbDest = ActiveWorkbook '//This is the new Workbook jSheets = wkbDest.Sheets.Count For j = 1 To jSheets Step 1 Sheets(j).Select '//Make all formulas of new file into values, and font = black// Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.Font.ColorIndex = 0 Application.CutCopyMode = False '//Delete all buttons in worksheet// iCount = ActiveSheet.Shapes.Count 'Set myVar = Sheets(ActiveSheet.Name).Shapes For i = iCount To 1 Step -1 ActiveSheet.Shapes(i).Delete 'myVar(i).Delete Next i Next j '//Save new workbook in current directory// TempFilePath = wkbRCOT.Path & "\" v_FileExtStr = ".xls" v_TimeStamp = Format(Now, "yymmddhhmm") TempFileName = "LOJ Review for LOGCAP Request - " _ & v_ReqName & " - " _ & v_Location & " - " _ & v_DateYYMMDD & " - " _ & v_TimeStamp '//Save new file as read-only// With wkbDest .SaveAs ThisWorkbook.Path & "\" & _ TempFileName & v_FileExtStr .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.