Export multiple worksheets without formula with the ability to select exact sheets and location

Question

I have an excel workbook where there is continuosly created new worksheets. Sometimes some of the worksheets needs to be archived and ideally removed from the workbook. The worksheets also needs to be archived in specific folders on SharePoint.

Right now the following VBA does the trick. However, it copies all the cells from the workbook which I then have to move to correct location:

Option Explicit

Sub WorksheetExport()

    Dim ws As Worksheet
    Dim wsDash As Worksheet
    Dim wbToSave As Workbook
    Dim filePathToSave As String
        
    Application.ScreenUpdating = False
        
    Set wsDash = Worksheets("LAJ")
    
    filePathToSave = "C:\Test\Example\"
    
    For Each ws In ThisWorkbook.Worksheets
    
        If ws.Name <> wsDash.Name Then
        
            ws.Copy
            
            With ActiveSheet.UsedRange.Cells
                
                .Value = .Value
                
            End With
            
            Set wbToSave = ActiveWorkbook
            
            wbToSave.SaveAs _
                Filename:=filePathToSave & wbToSave.Worksheets(1).Name & ".xlsx", _
                FileFormat:=51
        
            wbToSave.Close True
        
        End If
    
    Next ws
    
    Application.ScreenUpdating = True
    
End Sub

If possible I would like to be able to choose both the specific worksheets to be moved/copied and the specific location to move all the chosen worksheets to. Preferably in a dialog box for user friendliness.

Hope you can help!

I'm am new to excel and haven't been able to find an answer on google.

Answer 1

try

Sub ExportSheets()
    Dim sheetNames As String
    Dim sheetname
    Dim filePathToSave As String
    Dim FldrPicker As FileDialog
    
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

  With FldrPicker
    .Title = "Select Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button
    filePathToSave = .SelectedItems(1) & "\"
  End With
    
    sheetNames = InputBox("Enter the sheet name(s) you want to export (separated by semicolon):")

If sheetNames <> "" Then
        Dim wbSource As Workbook
        Set wbSource = ThisWorkbook
        Dim wbDest As Workbook

  If InStr(sheetNames, ";") = 0 Then
            Set wbDest = Workbooks.Add
            wbSource.Sheets(sheetNames).Copy After:=wbDest.Sheets(wbDest.Sheets.Count)
        
            Application.DisplayAlerts = False
            wbDest.SaveAs _
            Filename:=filePathToSave & sheetNames & ".xlsx", _
                FileFormat:=51
            wbDest.Close
            'wbSource.Worksheets(sheetnames).Delete' uncomment if you want to delete the sheet
            Application.DisplayAlerts = True
  Else
        Dim sheetArray As Variant
        sheetArray = Split(sheetNames, ";")
    
         For Each sheetname In sheetArray
            Set wbDest = Workbooks.Add
            wbSource.Sheets(sheetname).Copy After:=wbDest.Sheets(wbDest.Sheets.Count)
        
            Application.DisplayAlerts = False
            wbDest.SaveAs _
            Filename:=filePathToSave & sheetname & ".xlsx", _
                FileFormat:=51
            wbDest.Close
            'wbSource.Worksheets(sheetname).Delete' uncomment if you want to delete the sheet
            Application.DisplayAlerts = True
           Next sheetname
  End If
Else
    Exit Sub
End If

MsgBox "Export complete!"
End Sub