I have been working on my code to get the system to export specific sheet based only on what is visible in the system yet, for some reason I continue to struggle when it is trying to run the export with getting only the specified sheets to export. I know this has to be something simple that I am missing but I am unable to locate what that might be. Any assistance would be greatly appreciated.

Private Sub ExportSheets()       'saves all visible sheets as new xlsx files
    Dim ws As Worksheet, wbNew As Workbook
    Dim myWorksheets() As String 'Array to hold worksheet names to copy
    Dim sFolderPath As String
    Dim fs As Object
    Dim FileName1 As String
    Dim i As Integer

    Set wbNew = Application.ThisWorkbook
    FileName1 = Range("PMC_Name").Value
    sFolderPath = wbNew.Path & "\" & FileName1 & " - Import Templates"
    myWorksheets = Split("Chart of Accounts, Custom Mapping File, Custom Chart of Accounts,Conventional Default COA,Conventional Mapping File,CONV Chart of Accounts,HUD Chart of Accounts,Affordable Default COA,Affordable Mapping File,Entities,Properties,Floors,Units,Area Measurement,Tenants,Account Labels,Leases,Scheduled Charges,Tenant Beginning Balances,Vendors,Vendor Beginning Balances,Customers,Customer Beginning Balances,GL Beginning Balances,GL Detail,Bank Accounts,Budgets,Budgeting COA,Budgeting Conventional COA,Budgeting Affordable COA,Budgeting Job Positions,Budgeting Employee List,Budgeting Workers Comp,Expense Pools,Lease Recoveries,Index Code,Lease Sales,Option Types,Clause Types,Lease Clauses,Lease Options,Budgeting Current Budget Import,Job Cost,Draw Model Detail,Job Cost History,Job Cost Budgets,Fixed Assets,Condo Properties,Owners,Ownership Information,Ownership Billing,Owner Charges", ",") 'this contains an array of the sheets. You need to put the real sheet names here.
    
    If Dir(sFolderPath, vbDirectory) <> "" Then
        'If the folder does exist error
        MsgBox "The folder currently exists, please rename or delete the folder.", vbCritical, "Error"
    
        Exit Sub
        'If the folder does not exist create folder and export
    End If
    
    MkDir sFolderPath
    Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Sheets                      'for each worksheet
        'if it's visible:
        If Sheets(myWorksheets(i)).visible Then
            Debug.Print "Exporting: " & ws.Name
            ws.Copy '(if no params specified, COPY creates   activates a new wb)
            Set wbNew = Application.ActiveWorkbook          'get new wb object
            wbNew.SaveAs sFolderPath & "\" & ws.Name & ".csv", 23 'save new wb
            wbNew.Close                                     'close new wb
            Set wbNew = Nothing                             'cleanup
        End If
    Next ws
    Set ws = Nothing                                        'clean up
    Application.ScreenUpdating = False
    
    MsgBox "Sheet Export is now Complete. You can find the files at the following path." & vbNewLine & vbNewLine & sFolderPath, vbExclamation, "Export Sheets Complete"
End Sub

CodePudding user response：

Export Sheets

Sub ExportSheets()       'saves all visible sheets as new xlsx files
    
    Const PROC_TITLE As String = "Export Sheets"
    Const SHEET_LIST As String _
        = "Chart of Accounts,Custom Mapping File,Custom Chart of Accounts," _
        & "Conventional Default COA,Conventional Mapping File," _
        & "CONV Chart of Accounts,HUD Chart of Accounts," _
        & "Affordable Default COA,Affordable Mapping File,Entities," _
        & "Properties,Floors,Units,Area Measurement,Tenants,Account Labels," _
        & "Leases,Scheduled Charges,Tenant Beginning Balances,Vendors," _
        & "Vendor Beginning Balances,Customers,Customer Beginning Balances," _
        & "GL Beginning Balances,GL Detail,Bank Accounts,Budgets," _
        & "Budgeting COA,Budgeting Conventional COA,Budgeting Affordable COA," _
        & "Budgeting Job Positions,Budgeting Employee List," _
        & "Budgeting Workers Comp,Expense Pools,Lease Recoveries,Index Code," _
        & "Lease Sales,Option Types,Clause Types,Lease Clauses,Lease Options," _
        & "Budgeting Current Budget Import,Job Cost,Draw Model Detail," _
        & "Job Cost History,Job Cost Budgets,Fixed Assets,Condo Properties," _
        & "Owners,Ownership Information,Ownership Billing,Owner Charges"
    
    Dim swb As Workbook: Set swb = ThisWorkbook
    Dim sws As Worksheet: Set sws = swb.Sheets("Sheet1") ' adjust!
    
    Dim PMC As String: PMC = CStr(sws.Range("PMC_Name").Value)
    Dim dFolderPath As String
    dFolderPath = swb.Path & "\" & PMC & " - Import Templates\"
    
    If Len(Dir(dFolderPath, vbDirectory)) > 0 Then
        MsgBox "The folder already exists. " _
            & "Please rename or delete the folder.", vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    MkDir dFolderPath
    
    Dim SheetNames() As String: SheetNames = Split(SHEET_LIST, ",")
    
    Application.ScreenUpdating = False
           
    Dim dwb As Workbook, ssh As Object, SheetName
    
    For Each SheetName In SheetNames
        On Error Resume Next
            Set ssh = swb.Sheets(SheetName)
        On Error GoTo 0
        If Not ssh Is Nothing Then ' sheet exists
            If ssh.Visible Then ' sheet is visible
                Debug.Print "Exporting: " & ssh.Name
                ssh.Copy ' creates a single-sheet workbook
                Set dwb = Workbooks(Workbooks.Count)
                dwb.SaveAs dFolderPath & ssh.Name & ".csv", xlCSVWindows ' 23
                dwb.Close SaveChanges:=False
            'Else ' sheet is not visible; do nothing
            End If
            Set ssh = Nothing ' reset for the next iteration
        'Else ' sheet doesn't exist; do nothing
        End If
    Next SheetName
    
    Application.ScreenUpdating = True
    
    MsgBox "Sheet Export is now complete. " _
        & "You can find the files in the following path:" & vbLf & vbLf _
        & dFolderPath, vbInformation, PROC_TITLE

End Sub