Exporting tabs in a range as values

[ardykav]

Hi,
I have a file with a lot of tabs and have had a macro (below) thats always worked fine. It basically exports specific tabs into a new workbook with all the data in it moved across as values.

However now I want it to export a number of tabs but rather then specifying the tabs in the code I just want it to pick up a named range called "Tabsforexport" on the list tab.

I am guessing I just need to edit the code below where it specifies the array but not entirely sure of the best approach.

thanks in advance

Sub Exportas()
    Dim NewName As String
    Dim nm As Name
    Dim ws As Worksheet
    
    If MsgBox("This will copy sheets to a new workbook" _
    , vbYesNo, "Product Exporter") = vbNo Then Exit Sub
    
    With Application
        .ScreenUpdating = False
        
         '       Copy specific sheets
        On Error GoTo ErrCatcher
        Sheets(Array("CSV", "MQV")).Copy
        On Error GoTo 0
        
         '       Paste sheets as values
         '       Remove External Links, Hperlinks and hard-code formulas
         '       Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select
        
         '       Remove named ranges
        For Each nm In ActiveWorkbook.Names
          
        Next nm
        
         '       Input box to name new file
        NewName = InputBox("Please Specify the name of your new workbook", "What do you want to call your new workbook?")
        
         '       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
        'ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".pdf"
        ActiveWorkbook.Close SaveChanges:=False
        
        .ScreenUpdating = True
        MsgBox "File Exported"
    End With
    Exit Sub
    
ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
End Sub

 

[Norie]

Try this.

Sub Exportas()
Dim ws As Worksheet
Dim nm As Name
Dim NewName As String
Dim arrSheets As Variant

    If MsgBox("This will copy sheets to a new workbook" _
              , vbYesNo, "Product Exporter") = vbNo Then Exit Sub

    arrSheets = Range("Tabsforexport").Value ' Sheets("List").Range("Tabsforexport").Value
    
    arrSheets = Application.Transpose(arrSheets)
    
    With Application
        .ScreenUpdating = False

        '       Copy specific sheets
        On Error GoTo ErrCatcher
        Sheets(arrSheets).Copy
        On Error GoTo 0

        '       Paste sheets as values
        '       Remove External Links, Hperlinks and hard-code formulas
        '       Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select

        '       Remove named ranges
        For Each nm In ActiveWorkbook.Names

        Next nm

        '       Input box to name new file
        NewName = InputBox("Please Specify the name of your new workbook", "What do you want to call your new workbook?")

        '       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
        'ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".pdf"
        ActiveWorkbook.Close SaveChanges:=False

        .ScreenUpdating = True
        
        MsgBox "File Exported"
        
    End With
    
    Exit Sub

ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
End Sub

 

[ardykav]

That worked perfectly thanks so much

 

[ardykav]

I have a bit of an issue with this one, the file and tabs export but for some reason it doesnt paste the formulas that were in the original file across as values, they dont actually come across at all.

Also is there a way that I can specify only Columns A-P to be copied from all the tabs in the array?

Sub createmsl()
Dim ws As Worksheet
Dim nm As Name
Dim NewName As String
Dim arrSheets As Variant

    If MsgBox("This will copy sheets to a new workbook" _
              , vbYesNo, "Product Exporter") = vbNo Then Exit Sub

    arrSheets = Range("MLS").Value ' Sheets("List").Range("Tabsforexport").Value
    
    arrSheets = Application.Transpose(arrSheets)
    
    With Application
        .ScreenUpdating = False

        '       Copy specific sheets
        On Error GoTo ErrCatcher
    
          Sheets(arrSheets).Copy
        On Error GoTo 0

        '       Paste sheets as values
        '       Remove External Links, Hperlinks and hard-code formulas
        '       Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select

        '       Remove named ranges
        For Each nm In ActiveWorkbook.Names

        Next nm

l
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & "MSL File.xls"
    
        ActiveWorkbook.Close SaveChanges:=False

        .ScreenUpdating = True
        
        MsgBox "File Exported"
        
    End With
    
    Exit Sub

ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
End Sub