copy sheet paste values only

rjmdc

Well-known Member
Joined
Apr 29, 2020
Messages
672
Office Version
  1. 365
Platform
  1. Windows
i am doing something wrong
it creates 2 new workbooks not 1, one with the first table and one with the other
then it fails onthe save
dont comment on the call refresh that part works

i want 1 copy of the worksheet and paste and save
Rich (BB code):
Sub ExportFile()
    Dim wb                  As New Workbook
    Dim SaveFolder1         As String:          SaveFolder1 = "M:\my folder\Complete\"
    Dim FileName            As String
    Dim FileDateTime        As String:          FileDateTime = Format(Now, "m-d-yy hh-mm")
    Dim FullFileName        As String
    Dim tbl                 As ListObject

Call RefreshBook
   
        Worksheets("Check").Copy
        FileName = "Check " & Replace(Range("G3"), "/", ".")
        FullFileName = Replace(FileName, ".xlsx", "") ' & " (" & FileDateTime & ")"
    
    Set wb = Workbooks.Add it creates 2 books
    With wb
        .Activate
        .Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues it fails here
        .Sheets(1).Name = "Check"
        Selection.Columns.AutoFit
    End With

    'Save and Close New WB
    wb.SaveAs SaveFolder1 & FullFileName & ".xlsx", xlOpenXMLWorkbook
    wb.Close SaveChanges:=False
    DoEvents

    'Back to Main WB
    ThisWorkbook.Activate
    
    MsgBox "Process Complete"

End Sub
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
This instruction "copies" the sheet:
Worksheets("Check").Copy

But it is not actually copying the content of the sheet into memory, what it does is create a new book with the sheet, so the memory is empty, that's why you have an error when trying to paste, since memory is empty.

To copy the content of the sheet, you must copy the content of the cells, like this:

Rich (BB code):
Sub ExportFile()
  Dim wb                  As New Workbook
  Dim SaveFolder1         As String:          SaveFolder1 = "M:\my folder\Complete\"
  Dim FileName            As String
  Dim FileDateTime        As String:          FileDateTime = Format(Now, "m-d-yy hh-mm")
  Dim FullFileName        As String
  Dim tbl                 As ListObject

  Call RefreshBook
  
  FileName = "Check " & Replace(Range("G3"), "/", ".")
  FullFileName = Replace(FileName, ".xlsx", "") ' & " (" & FileDateTime & ")"

  Worksheets("Check").Cells.Copy    'copy cells to memory

  Set wb = Workbooks.Add 
  With wb
      .Activate
      .Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues 
      .Sheets(1).Name = "Check"
      Selection.Columns.AutoFit
  End With

  'Save and Close New WB
  wb.SaveAs SaveFolder1 & FullFileName & ".xlsx", xlOpenXMLWorkbook
  wb.Close SaveChanges:=False
  DoEvents

  'Back to Main WB
  ThisWorkbook.Activate
 
  MsgBox "Process Complete"

End Sub
 
Last edited:
Upvote 0
its a sheet with 4 tables
it copies the data not the table formats
please assist
 
Upvote 0
I show you 2 ways:
First:
VBA Code:
Sub ExportFile_1()
  Dim wb                  As New Workbook
  Dim SaveFolder1         As String:          SaveFolder1 = "M:\my folder\Complete\"
  Dim FileName            As String
  Dim FileDateTime        As String:          FileDateTime = Format(Now, "m-d-yy hh-mm")
  Dim FullFileName        As String

  Call RefreshBook
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  FileName = "Check " & Replace(Range("G3"), "/", ".")
  FullFileName = Replace(FileName, ".xlsx", "") ' & " (" & FileDateTime & ")"

  Set wb = Workbooks.Add
  With wb
      .Activate
      ThisWorkbook.Sheets("Check").Cells.Copy .Sheets(1).Range("A1")
      .Sheets(1).Name = "Check"
      .Sheets("Check").Cells.Copy
      .Sheets(1).Range("A1").PasteSpecial xlPasteValues
      Selection.Columns.AutoFit
  End With

  'Save and Close New WB
  wb.SaveAs SaveFolder1 & FullFileName & ".xlsx", xlOpenXMLWorkbook
  wb.Close SaveChanges:=False
  DoEvents

  'Back to Main WB
  ThisWorkbook.Activate
  
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True

  MsgBox "Process Complete"
End Sub


Second:

VBA Code:
Sub ExportFile_2()
  Dim SaveFolder1         As String:          SaveFolder1 = "c:\trabajo\" '"M:\my folder\Complete\"
  Dim FileName            As String
  Dim FileDateTime        As String:          FileDateTime = Format(Now, "m-d-yy hh-mm")
  Dim FullFileName        As String

  Call RefreshBook
   
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  FileName = "Check " & Replace(Range("G3"), "/", ".")
  FullFileName = Replace(FileName, ".xlsx", "") ' & " (" & FileDateTime & ")"

  Sheets("Check").Copy
  ActiveWorkbook.Sheets(1).Cells.Copy
  ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
  'Save and Close New WB
  
  ActiveWorkbook.SaveAs SaveFolder1 & FullFileName & ".xlsx", xlOpenXMLWorkbook
  ActiveWorkbook.Close SaveChanges:=False
  DoEvents

  'Back to Main WB
  ThisWorkbook.Activate
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  
  MsgBox "Process Complete"
End Sub
 
Last edited:
Upvote 0
Second:

VBA Code:
Sub ExportFile_2()
  Dim SaveFolder1         As String:          SaveFolder1 = "M:\my folder\Complete\"
  Dim FileName            As String
  Dim FileDateTime        As String:          FileDateTime = Format(Now, "m-d-yy hh-mm")
  Dim FullFileName        As String

  Call RefreshBook
   
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  FileName = "Check " & Replace(Range("G3"), "/", ".")
  FullFileName = Replace(FileName, ".xlsx", "") ' & " (" & FileDateTime & ")"

  Sheets("Check").Copy
  ActiveWorkbook.Sheets(1).Cells.Copy
  ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
  'Save and Close New WB
  
  ActiveWorkbook.SaveAs SaveFolder1 & FullFileName & ".xlsx", xlOpenXMLWorkbook
  ActiveWorkbook.Close SaveChanges:=False
  DoEvents

  'Back to Main WB
  ThisWorkbook.Activate
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  
  MsgBox "Process Complete"
End Sub
 
Upvote 0
hi
now it copied the tables beautifully but also the formulas
how can i stop that

i used metod 1
 
Upvote 0
Check option 1 again, I did an update.
VBA Code:
Sub ExportFile_1()
  Dim wb                  As New Workbook
  Dim SaveFolder1         As String:          SaveFolder1 = "M:\my folder\Complete\"
  Dim FileName            As String
  Dim FileDateTime        As String:          FileDateTime = Format(Now, "m-d-yy hh-mm")
  Dim FullFileName        As String

  Call RefreshBook
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  FileName = "Check " & Replace(Range("G3"), "/", ".")
  FullFileName = Replace(FileName, ".xlsx", "") ' & " (" & FileDateTime & ")"

  Set wb = Workbooks.Add
  With wb
      .Activate
      ThisWorkbook.Sheets("Check").Cells.Copy .Sheets(1).Range("A1")
      .Sheets(1).Name = "Check"
      .Sheets(1).Cells.Copy
      .Sheets(1).Range("A1").PasteSpecial xlPasteValues
      Selection.Columns.AutoFit
  End With

  'Save and Close New WB
  wb.SaveAs SaveFolder1 & FullFileName & ".xlsx", xlOpenXMLWorkbook
  wb.Close SaveChanges:=False
  DoEvents

  'Back to Main WB
  ThisWorkbook.Activate
 
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True

  MsgBox "Process Complete"
End Sub
 
Upvote 0
Check this:


VBA Code:
Sub ExportFile_1()
  Dim wb                  As New Workbook
  Dim SaveFolder1         As String:          SaveFolder1 = "M:\my folder\Complete\"
  Dim FileName            As String
  Dim FileDateTime        As String:          FileDateTime = Format(Now, "m-d-yy hh-mm")
  Dim FullFileName        As String

  Call RefreshBook
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  FileName = "Check " & Replace(Range("G3"), "/", ".")
  FullFileName = Replace(FileName, ".xlsx", "") ' & " (" & FileDateTime & ")"

  Set wb = Workbooks.Add
  With wb
      .Activate
      ThisWorkbook.Sheets("Check").Cells.Copy .Sheets(1).Range("A1")
      .Sheets(1).Name = "Check"
      .Sheets(1).Cells.Copy
      .Sheets(1).Range("A1").PasteSpecial xlPasteValues
      Selection.Columns.AutoFit
  End With

  'Save and Close New WB
  wb.SaveAs SaveFolder1 & FullFileName & ".xlsx", xlOpenXMLWorkbook
  wb.Close SaveChanges:=False
  DoEvents

  'Back to Main WB
  ThisWorkbook.Activate
  
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True

  MsgBox "Process Complete"
End Sub
 
Upvote 1

Forum statistics

Threads
1,214,985
Messages
6,122,606
Members
449,089
Latest member
Motoracer88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top