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
897 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
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

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Excel Named Range 31 44
Tricky Shapes formula 3 12
Excel Total at footer of invoice 5 17
EXCHANGE, OUTLOOK, CALENDAR 12 19
This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This video demonstrates how to sync Microsoft Exchange Public Folders with smartphones using CodeTwo Exchange Sync and Exchange ActiveSync. To learn more about CodeTwo Exchange Sync and download the free trial, go to: http://www.codetwo.com/excha…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

680 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