?
Solved

Excel VBA - Pass x-number of worksheet names to a routine that copies them into a separate file.

Posted on 2011-02-19
4
Medium Priority
?
915 Views
Last Modified: 2012-05-11
I'm trying to pass several Worksheet names (Dim type String) to a routine that will copy those worksheets into a new workbook that is created on the fly.

Various subs will call the routine that creates the new file.  These various subs will pass different worksheet (tab) names; some would only pass one, others would pass several.

See attached code to see my attempt.
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

Open in new window

0
Comment
Question by:AndresHernando
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 34932534
Try passing an array.  Modified to delete the globals, set an array of sheets and pass it to the sub as below.

Chris
'Option Explicit

'Public v_Wks1Name As String
'Public v_Wks2Name As String


Sub M_Email_AppvlReqLOJ()
'//Creates two stand-alone to email//
Dim v_WksNames() As Variant
    

    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"
    v_WksNames = Array("RequirementSummary", "Reviewer1", "Reviewer2")
    
    Call M_CreateMultiWksFile(v_WksNames)

    Worksheets("Approvals").Select '//in original workbook//
    [Rd_Reviewer1].Select
    
    
    With Application
        .EnableEvents = True
    End With

End Sub


Sub M_CreateMultiWksFile(v_WksNames)
'//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(v_WksNames).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

Open in new window

0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34932537
Change this

Sub M_CreateMultiWksFile(v_Wks1Name, v_Wks2Name)

to

Sub M_CreateMultiWksFile(MyArray() as String))

And then amend the rest of the code. You can pass the sheet names in an array :-)

Sid

0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34932540
Beaten...

Sid
0
 

Author Closing Comment

by:AndresHernando
ID: 34932844
Worked great.  Thanks!  --Andres
0

Featured Post

Office 365 Training for Admins - 7 Day Trial

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.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will help to fix the below error for MS Exchange server 2010 I. Out Of office not working II. Certificate error "name on the security certificate is invalid or does not match the name of the site" III. Make Internal URLs and External…
Check out this step-by-step guide for using the newly updated Experts Exchange mobile app—released on May 30.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

719 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question