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

0 votes

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

Right now the following VBA does the trick. Nevertheless, it duplicates every cell from the workbook, which I must then relocate to the proper place.

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 it is possible, I would like to be able to select the precise worksheets to be duplicated or relocated as well as the precise location to which all of the selected worksheets will be transported. Preferably in a dialogue box for user comfort.

Mar 24, 2023 in Others by narikkadan
• 63,420 points
316 views

1 answer to this question.

0 votes

Try this:

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
answered Mar 24, 2023 by Kithuzzz
• 38,010 points

Related Questions In Others

0 votes
1 answer

VBA Export as PDF and Save to Location with name as per a Cell in the worksheet

Following is the code that gets generated ...READ MORE

answered Jan 20, 2023 in Others by narikkadan
• 63,420 points
1,388 views
–1 vote
0 answers
0 votes
1 answer
0 votes
1 answer

IF formula to compare a date with current date and return result

You can enter the following formula in ...READ MORE

answered Sep 27, 2022 in Others by narikkadan
• 63,420 points
582 views
0 votes
1 answer

Sort Excel worksheets based on name, which is a date

Sorting sheets of a workbook are rather ...READ MORE

answered Oct 17, 2022 in Others by narikkadan
• 63,420 points
372 views
0 votes
1 answer

Having issues with pop-up alert in excel. (Visual Basic)

You may find the following code of ...READ MORE

answered Feb 4, 2023 in Others by narikkadan
• 63,420 points
350 views
0 votes
1 answer

How can I stop my vba code from giving me an error 424?

Object Variables in Loops The main issue was ...READ MORE

answered Feb 9, 2023 in Others by narikkadan
• 63,420 points
524 views
0 votes
1 answer

Copying and pasting from one workbook to another doesn't work

Your ranges aren't fully qualified. Excel will make ...READ MORE

answered Feb 18, 2023 in Others by narikkadan
• 63,420 points
269 views
0 votes
1 answer

How to compare 2 cells with delimited items in each and output the difference in items?

The following function would do this for ...READ MORE

answered Feb 23, 2023 in Others by Kithuzzz
• 38,010 points
332 views
0 votes
1 answer
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP