dynamic worksheet(s) data manipulation before copy to new workbook-CodePudding

I am trying to copy multiple worksheets to a new workbook. The worksheet names are defined in an array named sWorkSheetNames, which are then copied to a new workbook via swb.Worksheets(sWorkSheetNames).Copy.

The challenge I am facing is that the data on those worksheets is captured via complex indirect() formulas, which in turn pull data from a 100k long "DATA" worksheet. Now, via the above copy command, the indirect formulas break and throw a #REF error, which I can only circumvent by also copying the massive DATA sheet to the new workbook, then replace the formulas with values, and only then delete the DATA sheet, which is what I do not want to do.

My question now is this: how can I most effectively copy x number of sheets from the source workbook, replace the used range data to values, and then copy it to a new workbook, without knowing the worksheet name of the copied worksheets (copies in the same workbook are named "SomeName (x)" where x could be 1,2,3,4,etc depending on the number of copies)?

Thank you very much

Dim sWorkSheetNames() As Variant
sWorkSheetNames = Array("Daily Summary", "Monthly Summary")

' Reference the source workbook ('swb').
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code

' Copy the worksheets to a new workbook.
swb.Worksheets(sWorkSheetNames).Copy

' Destination

' Reference this new workbook, the destination workbook ('dwb').
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)

Dim dws As Worksheet
Dim drg As Range

' Convert formulas to values
' breaks the formulas since the indirect DATA sheet is not present in the new workbook
' copy paste to value needs to happen in the swb before copy
For Each dws In dwb.Worksheets
    Set drg = dws.UsedRange
    drg.Value = drg.Value
Next dws

CodePudding user response：

Copy Worksheets From a List

A Quick Fix

Replace

drg.Value = drg.Value

with

drg.Value = swb.Worksheets(dws.Name).Range(drg.Address).Value

Optionally

To get the worksheets in the order they appear in the array, copy each worksheet separately.

Sub ExportWorksheets()
    
    ' Write the worksheet names to a variant array.
    Dim sWorkSheetNames() As Variant
    sWorkSheetNames = VBA.Array("Daily Summary", "Daily Report")
    ' 'VBA.' ensures a zero-based array ('Option Base' related).
    
    ' Reference the source workbook ('swb').
    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    
    ' Declare additional variables.
    Dim sws As Worksheet, srg As Range
    Dim dwb As Workbook, dws As Worksheet, drg As Range
    Dim n As Long
    
    For n = 0 To UBound(sWorkSheetNames)
        
        ' Reference the source worksheet ('sws').
        Set sws = swb.Worksheets(sWorkSheetNames(n))
        
        ' Check if it's the first worksheet to be copied and copy accordingly.
        If n = 0 Then ' is the first worksheet
            ' Copy the source worksheet to a new single-worksheet workbook.
            sws.Copy
            ' Reference this new workbook, the destination workbook ('dwb').
            Set dwb = Workbooks(Workbooks.Count)
        Else ' is not the first worksheet
            ' Copy the source worksheet to the end of the destination workbook.
            sws.Copy After:=dwb.Sheets(dwb.Sheets.Count)
        End If
        
        ' Reference the destination worksheet ('dws').
        Set dws = dwb.Worksheets(dwb.Worksheets.Count)
        ' Reference the destination (used) range ('drg').
        Set drg = dws.UsedRange
        ' Reference the source (used) range ('srg').
        Set srg = sws.Range(drg.Address)
        
        ' Copy values (by assignment).
        drg.Value = srg.Value
    
    Next n

    ' Continue to save the destination workbook...

    dwb.Saved = True ' just for easy closing while testing this code

End Sub

CodePudding user response：

If you copy cells formulas, it is not possible anymore to transform their resulted value (error, or not) in the before copying ones.
That's why the copying must be done for the cells value from the source sheet. Automatically creating a workbook containing the two sheets, cannot handle the formulas aspect. It is necessary to do it sheet by sheet, but not using clipboard, the code should be fast enough:

Sub copySheets()
 Dim sWorkSheetNames() As Variant
 sWorkSheetNames = Array("Sheet151", "Sheet152") ' Array("Daily Summary", "Monthly Summary")

 ' Reference the source workbook ('swb').
 Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code

 ' Reference this new workbook, the destination workbook ('dwb').
 Dim dwb As Workbook, shNo As Long, i As Long, sh As Worksheet
    Set dwb = Workbooks.Add        'create a new workbook
    shNo = dwb.Worksheets.count    'extract its (default) number of sheets
    
 For i = 0 To UBound(sWorkSheetNames)  'iterate between the sheet names array:
    If i   1 <= shNo Then
        Set sh = dwb.Worksheets(i   1) 'use an existing sheet
    Else
        Set sh = dwb.Worksheets.Add(After:=dwb.Worksheets(dwb.Worksheets.count)) 'insert a new sheet
    End If
    sh.name = sWorkSheetNames(i)  'name the sheet to be used for copying
    With swb.Worksheets(sWorkSheetNames(i)).UsedRange
           sh.Range("A1").Resize(.rows.count, .Columns.count).Value = .Value 'copy the cells value
            With sh.Range("A1").Resize(.rows.count, .Columns.count)
                .EntireColumn.AutoFit  'a little format. Other features can be added here, if necessary
            End With
    End With
 Next
End Sub

If you always need copying only two sheets, the copying itself can be simplified. I designed the code to also accept more than existing number of sheets in the new workbook (inserting new ones).