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

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

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

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Read this checklist to learn more about the 15 things you should never include in an email signature.
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…
This video shows how to quickly and easily add an email signature for all users on Exchange 2016. The resulting signature is applied on a server level by Exchange Online. The email signature template has been downloaded from: www.mail-signatures…

856 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