Save Selected Sheets in another workbook-CodePudding

Wondering why I can't do :

For i = 1 To ThisWorkbook.Sheets.Count
    If ThisWorkbook.Sheets(i).Name <> "DO NOT SAVE" Then ThisWorkbook.Sheets(i).Select Replace:=False
Next i

Selection.Copy

what would be the best way to save all sheets which does not match DO NOT SAVE name in another wb ?

CodePudding user response：

Try this:

Sub Tester()
    Dim ws As Worksheet, arr(), i As Long
    ReDim arr(0 To ThisWorkbook.Worksheets.Count - 2)
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "DO NOT SAVE" Then
            arr(i) = ws.Name
            i = i   1
        End If
    Next ws
    Worksheets(arr).Copy
End Sub

CodePudding user response：

A Reflection on the Sheets' Visibility

To export a single sheet to a new workbook, the sheet has to be visible.
To export multiple sheets (using an array of sheet names) to a new workbook, at least one of the sheets has to be visible, while very hidden sheets will not get exported (no error though).
In a given workbook, the following procedure will copy all its sheets, except the ones whose names are in a given array (Exceptions), to a new workbook if at least one of the sheets is visible.
Before copying, it will 'convert' the very hidden sheets to hidden and after the copying, it will 'convert' the originals and copies to very hidden.

Option Explicit

Sub ExportSheets( _
        ByVal wb As Workbook, _
        ByVal Exceptions As Variant)
    
    Dim shCount As Long: shCount = wb.Sheets.Count
    Dim SheetNames() As String: ReDim SheetNames(1 To shCount)
    
    Dim sh As Object
    Dim coll As Object
    Dim Item As Variant
    Dim n As Long
    Dim VisibleFound As Boolean
    Dim VeryHiddenFound As Boolean
    
    For Each sh In wb.Sheets
        If IsError(Application.Match(sh.Name, Exceptions, 0)) Then
            Select Case sh.Visible
            Case xlSheetVisible
                If Not VisibleFound Then VisibleFound = True
            Case xlSheetHidden ' do nothing
            Case xlSheetVeryHidden
                If Not VeryHiddenFound Then
                    Set coll = New Collection
                    VeryHiddenFound = True
                End If
                coll.Add sh.Name
            End Select
            n = n   1
            SheetNames(n) = sh.Name
        End If
    Next sh
    
    If n = 0 Then
        MsgBox "No sheet found.", vbExclamation
        Exit Sub
    End If

    If Not VisibleFound Then
        MsgBox "No visible sheet found.", vbExclamation
        Exit Sub
    End If
    If n < shCount Then ReDim Preserve SheetNames(1 To n) ' n - actual count
    
    If VeryHiddenFound Then ' convert to hidden
        For Each Item In coll
            wb.Sheets(Item).Visible = xlSheetHidden
        Next Item
    End If
    
    wb.Sheets(SheetNames).Copy ' copy to new workbook
    
    If VeryHiddenFound Then ' revert to very hidden
        Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
        For Each Item In coll
            wb.Sheets(Item).Visible = xlSheetVeryHidden
            dwb.Sheets(Item).Visible = xlSheetVeryHidden
        Next Item
    End If
    
    MsgBox "Sheets exported: " & n, vbInformation

End Sub


Sub ExportSheetsTEST()
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ExportSheets wb, Array("DO NOT SAVE")
End Sub

CodePudding user response：

Alternatively you could use the following snippet:

Sub CopyWorkbook()

   Dim i As Integer

   For i = 1 To ThisWorkbook.Sheets.Count
      If ThisWorkbook.Sheets(i).Name <> "DO NOT SAVE" Then
         Dim rng As Range
         Windows("SOURCE WORKBOOK").Activate
         rng = ThisWorkbook.Sheets(i).Cells
         rng.Copy Before:=Workbooks("TARGET WORKBOOK").Sheets(i)
      End If

   Next i
End Sub