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
865 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
  • 2
4 Comments
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
Comment Utility
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
Comment Utility
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
Comment Utility
Beaten...

Sid
0
 

Author Closing Comment

by:AndresHernando
Comment Utility
Worked great.  Thanks!  --Andres
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
excel file 5 44
Excel 2013 Problem 12 44
Out of stack space (Error 28) 5 22
Excel 2016 Hiding Toolbars 7 14
We are happy to announce a brand new addition to our line of acclaimed email signature management products – CodeTwo Email Signatures for Office 365.
This article explains in simple steps how to renew expiring Exchange Server Internal Transport Certificate.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This video discusses moving either the default database or any database to a new volume.

771 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now