Save workbook but as values only

[DipDip]

Hiya,
So I've found the following code from another thread, and adapted it:

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?

 

[maabadi]

Change Selection.PasteSpecial to Range("A199:AL396") or what you want.
I think you can remove
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
And change two next line to

Range("A199:AL396").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 

[DipDip]

Change Selection.PasteSpecial to Range("A199:AL396") or what you want.
I think you can remove
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
And change two next line to

Range("A199:AL396").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Unfortunately, that didn't work

 

[Fluff]

As you are asking a question I suspect that your code does not work, but you have not told us anything.
Care to explain what is not working?

 

[DipDip]

As you are asking a question I suspect that your code does not work, but you have not told us anything.
Care to explain what is not working?

It still copies over the information from below line 198.

I replaced the above quoted code with the following (unless I've not followed instructions correctly):

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
    Range("A1:AL198").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

 

[Fluff]

All this section of code is doing, is converting A1:AL198 to values on every sheet in the workbook, nothing more.

For i = 1 To ActiveWorkbook.Sheets.Count

ActiveWorkbook.Sheets(i).Activate

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

Having done that it saves the workbook with a new name.

 

[DipDip]

All this section of code is doing, is converting A1:AL198 to values on every sheet in the workbook, nothing more.

For i = 1 To ActiveWorkbook.Sheets.Count

ActiveWorkbook.Sheets(i).Activate

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

Having done that it saves the workbook with a new name.

For some reason when I am doing it, it's also copying data from A199:AL300, which I don't want it to do. Nothing else in the worksheet, beyond this, so I'm thinking it's copying the whole sheet and not just the selection. Not sure what is going wrong then.

 

[Fluff]

Are you saying that the formulae in A199:AL300 are getting converted into values?

 

[maabadi]

IF you want only copy A1:AL198 and Clearing others. You Should add
Range("A199:AL" & Cells(Rows.count, 1).end(xlup).row ).Clearcontents
After
PasteSpecial Lines

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
    Range("A1:AL198").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A199:AL" & Cells(Rows.count, 1).end(xlup).row ).Clearcontents
    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

 

[DipDip]

IF you want only copy A1:AL198 and Clearing others. You Should add
Range("A199:AL" & Cells(Rows.count, 1).end(xlup).row ).Clearcontents
After
PasteSpecial Lines

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
    Range("A1:AL198").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A199:AL" & Cells(Rows.count, 1).end(xlup).row ).Clearcontents
    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

Maabadi, you are a genius! Thank you to everyone who contributed to this .

Although just testing this now with the other excel macro-enabled file that I wanted to do this with, it won't work as it comes up with Run-time error 1004', We can't do that to a merged cell. Then when I click debug. Selection.Copy is highlighed in yellow.