Save multiple sheets to different locations using VBA, some have to be combined depending on a cell number.

Question

This might be an easy fix, but not as good in VBA as I would like to be.

I would like to export each sheet to a specific folder and filename based on the folder destination in cell A1 and the filename in cell B1 of each tab.

Some sheets would have to be combined into one workbook based on cell C1 and saved to Folder and Filename of the first page.

Any help would be appreciated.

Answer 1

Here is a sample, with the code from above, it works:

https://www.dropbox.com/s/l4360i3va7zxtek/abf9bf68-9041-40a4-9076-2b22233a6612.xlsm?dl=1

Customize the path in the sheets and run the code. File A.xlsx contains 2 sheets and B.xlsx 1 sheet afterwards.

Andreas.

Answer 2

Before they are sent, can I combine multiple sheets into a workbook, then send?

Answer 3

I still do not really have an idea.

A1 and B1 have a path and filename, so each sheet goes into a different file... from this point there is nothing that we can combine...

Andreas.

Answer 4

Thanks a lot, this helps in a big way, since I have 40+ pages, only sent a sample. I did have to remove the "'s from the file and folder name in A1 & B1

What I meant about the combined sheet is that there are 3 groups that have to be sent together.

IE: 601201 & 601202 have a number 9 in cell 3, on their page. Ideally these 2 sheets would be combined into 1 workbook and saved based on the same format.  Pages 601201 & 601202 would be 1 workbook saved to:

C:\Folder\SubFolder\Destination1\2019 FileName List 001-102

I have no idea what this should mean:

"Some sheets would have to be combined into one workbook based on cell C1"

Answer 5

I have no idea what this should mean:

"Some sheets would have to be combined into one workbook based on cell C1"

For everything else, look at the code below.

Andreas.

Sub Test()
  Dim Ws As Worksheet
  Dim Path As String, FName As String, Fullname As String
  Dim Exportsheets As New Collection
  For Each Ws In Worksheets
    Path = Ws.Range("A1")
    If Right(Path, 1) <> "\" Then Path = Path & "\"
    If Dir(Path, vbDirectory) = "" Then
      Select Case MsgBox("Folder '" & Path & "' didn't exist, I skip that sheet", vbOKCancel + vbInformation, Ws.Name)
        Case vbOK
          GoTo NextSheet
        Case vbCancel
          'Abort
          Exit Sub
      End Select
    End If
    FName = Ws.Range("B1")
    Fullname = Path & FName
    If Dir(Fullname, vbNormal) <> "" Then
      Select Case MsgBox("File '" & Fullname & "' aready exist, can I delete it?", vbYesNoCancel + vbQuestion + vbDefaultButton2, Ws.Name)
        Case vbNo
          'Skip
          GoTo NextSheet
        Case vbCancel
          'Abort
          Exit Sub
      End Select
    End If
    Exportsheets.Add Ws
NextSheet:
  Next
  
  Application.EnableEvents = False
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  For Each Ws In Exportsheets
    Path = Ws.Range("A1")
    FName = Ws.Range("B1")
    Fullname = Path & FName
    Ws.Copy
    DoEvents
    ActiveWorkbook.Close True, Fullname
  Next
  Application.EnableEvents = True
End Sub