Save workbook but as values only

DipDip

Board Regular
Joined
Jan 23, 2015
Messages
71
Office Version
  1. 365
Platform
  1. Windows
Hiya,
So I've found the following code from another thread, and adapted it:

VBA Code:
Sub SaveAsValues()
    Dim NewBook As Workbook
    Dim CurrentFile As String
    Dim NewFile As String
            
For i = 1 To ActiveWorkbook.Sheets.Count

ActiveWorkbook.Sheets(i).Activate

    Range("A1:AL198").Select
    
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    Range("A1").Select
    
Next i

    ActiveWorkbook.Worksheets(1).Activate
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    CurrentFile = ActiveWorkbook.FullName
 
    NewFile = "TNew Worksheet"
    ActiveWorkbook.SaveAs Filename:="C:\Test\" & NewFile & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    
    Application.DisplayAlerts = True
    Set NewBook = ActiveWorkbook
    Workbooks.Open CurrentFile
    NewBook.Close
   
    Application.ScreenUpdating = True
End Sub

However, I want it to just copy cells A1:AL198 as below line 198, is a load of calculations to get the top bit working. Can anyone help me with this?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,468
Office Version
  1. 365
Platform
  1. Windows
Do not use merged cells, they are an abomination & should be avoided like the plague.
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,774
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
VBA have problem with merged cell.
Only test this. may be work.
Change Selection method to with.
VBA Code:
Option Explicit
Sub SaveAsValues()
    Dim NewBook As Workbook
    Dim CurrentFile As String
    Dim NewFile As String
    Dim i As Long
For i = 1 To ActiveWorkbook.Sheets.Count

ActiveWorkbook.Sheets(i).Activate

    With Range("A1:AL198")
   
    .Copy
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A199:AL" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    End With
   
Next i

    ActiveWorkbook.Worksheets(1).Activate
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    CurrentFile = ActiveWorkbook.FullName

    NewFile = "TNew Worksheet"
    ActiveWorkbook.SaveAs Filename:="C:\Test\" & NewFile & ".xlsx", FileFormat:=xlOpenXMLWorkbook
   
    Application.DisplayAlerts = True
    Set NewBook = ActiveWorkbook
    Workbooks.Open CurrentFile
    NewBook.Close
  
    Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,129,386
Messages
5,636,010
Members
416,892
Latest member
Bensch

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
Top