Is there any way to copy a complete sheet to another workbook by pasting only the values, but keeping the tables?

Question

I am going to keep it simple:

Is there any way to copy a complete sheet to another workbook by pasting only the values, but keeping the tables ?

Right now I am using the code below, but I can't seem to keep my tables in the new file that is created.

Any ideas on how to solve this ?

Sub export()

Dim SourceBook As Workbook, DestBook As Workbook, SourceSheet As Worksheet, DestSheet As Worksheet, ws As Worksheet
Dim SavePath As String, i As Integer

Set SourceBook = ThisWorkbook

SavePath = Sheets("UPDATE").Range("F23").Text

Set DestBook = Workbooks.Add

i = 1
For Each SourceSheet In SourceBook.Worksheets
    
    If i <> 1 Then
        
        SourceSheet.Cells.Copy
        
        If i > 2 Then DestBook.Worksheets.Add After:=DestBook.Sheets(DestBook.Sheets.Count)
        If UCase(SourceSheet.Name) = "DASHBOARD" Then
            Range("A1").Select
            ActiveSheet.Paste
        Else
            With Range("A1")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats 'Delete if you don't want formats copied
            End With
        End If

        ActiveSheet.Name = SourceSheet.Name
        DestBook.Activate
        With ActiveWindow
            .DisplayGridlines = False
            '.DisplayWorkbookTabs = False
        End With
        
    End If
    
    i = i + 1
    
Next SourceSheet

SourceBook.Activate
Application.DisplayAlerts = False 'Delete if you want overwrite warning
DestBook.SaveAs Filename:=Replace(SavePath & "\" & Sheets("UPDATE").Range("F22").Text & ".xlsx", "\\", "\")
Application.DisplayAlerts = True 'Delete if you delete other line

SavePath = DestBook.FullName
DestBook.Close 'Delete if you want to leave copy open
MsgBox ("A copy has been saved to " & SavePath)

End Sub

What is the structure of the sheet? Does it contain one table or multiple? — BigBen, Jun 17 '21 at 15:20
If the table starts in the upper left-hand corner (cell A1), then probably easiest to just recreate the table programmatically. — BigBen, Jun 17 '21 at 15:46
@BigBen, yes it does. I tried to implement some additional code right before i = i+1 in which I create a table on the newly created sheet but I can't seem to make it work. Any suggestions maybe ? — Janson Martin, Jun 17 '21 at 16:19

score 1 · Accepted Answer · answered Jun 17 '21 at 16:48

1

Perhaps just recreate the table programmatically, something like:

With ActiveSheet
    Dim table As ListObject
    Set table = .ListObjects.Add(xlSrcRange, .UsedRange)
End With

answered Jun 17 '21 at 16:48

BigBen

46,229
7
24
40

That's a great idea. It'll work if you don't have to preserve the table names and the tables are the only 'thing' in the worksheets. – VBasic2008 Jun 18 '21 at 06:09

score 1 · Answer 2 · answered Jun 18 '21 at 06:07

Export Workbook (Tables as Values)

The first worksheet will be skipped, while the Dashboard worksheet will be copied as-is. The rest will be copied with tables containing values instead of formulas.

Option Explicit

Sub ExportWorkbook()

    Dim SourceBook As Workbook, DestBook As Workbook
    Dim SourceSheet As Worksheet ', DestSheet As Worksheet
    Dim tbl As ListObject
    Dim FolderPath As String, FileName As String, SavePath As String
    Dim i As Long
    
    Set SourceBook = ThisWorkbook
    
    ' If the first worksheet is named "UPDATE" then use ...Worksheets(1)
    ' to remove confusion (consistency issue).
    With SourceBook.Worksheets("UPDATE")
        FolderPath = .Range("F23").Value
        FileName = .Range("F22").Value & ".xlsx"
    End With
    SavePath = Replace(FolderPath & "\" & FileName, "\\", "\")
    
    Application.ScreenUpdating = False
    
    ' If a workbook with the same name as the name of the Destination Workbook
    ' is already open, close it.
    On Error Resume Next
    Set DestBook = Workbooks(FileName)
    On Error GoTo 0
    If Not DestBook Is Nothing Then
        DestBook.Close SaveChanges:=True
    End If
   
    i = 1
    
    For Each SourceSheet In SourceBook.Worksheets
        
        If i > 1 Then ' Skip first worksheet.
            
            If i = 2 Then ' Create Destination Workbook from 2nd worksheet.
                SourceSheet.Copy ' creates new workbook containing one worksheet
                Set DestBook = ActiveWorkbook
            Else ' Copy worksheet to Destination Workbook.
                SourceSheet.Copy After:=DestBook.Sheets(DestBook.Sheets.Count)
            End If
            ' Note that the current destination worksheet becomes active.
            ' (You could do 'Set DestSheet = ActiveSheet'.)
            
            If StrComp(SourceSheet.Name, "DASHBOARD", vbTextCompare) <> 0 Then
                For Each tbl In ActiveSheet.ListObjects
                    tbl.DataBodyRange.Value = tbl.DataBodyRange.Value
                Next tbl
            End If
            
            With ActiveWindow
                .DisplayGridlines = False
                '.DisplayWorkbookTabs = False
            End With
        
        End If
        
        i = i + 1
        
    Next SourceSheet
    
    Application.DisplayAlerts = False 'Delete if you want overwrite warning
    DestBook.SaveAs FileName:=SavePath
    Application.DisplayAlerts = True 'Delete if you delete other line
    
    DestBook.Worksheets(1).Activate
    DestBook.Saved = True ' Just for easy closing while testing (out-comment)
    'DestBook.Close 'Out-comment if you want to leave copy open
    
    Application.ScreenUpdating = True
    
    MsgBox "A copy has been saved to " & SavePath, vbInformation, "Export"

End Sub

Is there any way to copy a complete sheet to another workbook by pasting only the values, but keeping the tables?

2 Answers2

Export Workbook (Tables as Values)