Set range to current values and current formatting - excel

Question

I am trying to cycle through multiple sheets in a work book and replace the formulas with values.
I would like to retain any formatting in the cells though (e.g. when I run this, it will not only change 3% to .03, but preserve any formatting)
Thank you!
Below is my code:
Sub copypastfa()
Dim count As Integer
For count = 1 To 9
Dim rng As Range
Set rng = Worksheets(1).Range("A1:Z101")
ActiveSheet.Range("A1").Resize(rng.Rows.count, rng.Columns.count).Cells.Value = rng.Cells.Value
Worksheets(ActiveSheet.Index + 1).Select
Next count
End Sub

Answer 1

Two unconvential approaches (other than copying)
As you found out yourself, assigning (datafield) arrays to target ranges transport only values.
[0) The conventional way]
A familiar way to solve the asked requirement to include all formats would consist in subsequent copying/pasting formats as well as values as follows:
Sub TheConventionalWay()
'0) get worksheets collection
Dim w As Sheets ' use the wider declaration type here and
Set w = ThisWorkbook.Worksheets ' assign only worksheets to the sheets collection
'1) define source range
Dim rng As Range
Set rng = w(1).Range("A1:Z101")
'2) Copy-Paste
rng.Copy
Dim i As Long
For i = 1 to 9
With Worksheets(i).Range(rng.Address)
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteValues
Next
End Sub
... but I would also like to demonstrate two not so well-known quick approaches here:
Approach 1) via xlRangeValueXMLSpreadsheet
This approach allows to get the complete spreadsheet info in an XML string which can be reassigned to the size identical target ranges. Furthermore it needs no double-assignements.
Sub XMLSpreadsheetApproach()
'0) get worksheets collection
Dim w As Sheets ' use the wider declaration type here and
Set w = ThisWorkbook.Worksheets ' assign only worksheets to the sheets collection
'1) define source range
Dim rng As Range
Set rng = w(1).Range("A1:Z101")
rng.Value2 = rng.Value2 ' change formulae to values
'2) Get Value(xlRangeValueXMLSpreadsheet), aka Value(11)
Dim Val11 as string: Val11 = rng.Value(11)
'3) Pass full XML Spreadsheet info to following worksheets
Dim i As Long
For i = 2 to 9 ' suffices to start at 2
Worksheets(i).Range(rng.Address).Value(11) = Val11 ' xlRangeValueXMLSpreadsheet = 11
Next
End Sub
Syntax
Range.Value (RangeValueDataType)
where RangeValueDataType xlRangeValueXMLSpreadsheet - equalling 11 - returns the values, formatting, formulas, and names of the specified Range object in the XML Spreadsheet format.
Approach 2) via FillAcrossSheets method
The widely unknown FillAcrossSheets method copies a range to the same area on all other worksheets in a collection.
Syntax
.FillAcrossSheets (Range, Type)
where Type (i.e. the XlFillWith enumeration) distinguishes between
-4104 .. xlFillWithAll copies contents and formats.
2 ........... xlFillWithContents copies contents only.
-4122 .. xlFillWithFormats copies formats only.
Sub FillAcrossSheetsApproach()
'0) get worksheets collection
Dim w As Sheets ' use the wider declaration type here and
Set w = ThisWorkbook.Worksheets ' assign only worksheets to the sheets collection
'1) define source range
Dim rng As Range
Set rng = w(1).Range("A1:Z101")
rng.Value2 = rng.Value2 ' change formulae to values
'2) apply to ALL sheets
w.FillAcrossSheets rng, xlFillWithAll
End Sub
If, however you want to include only a series of sheets, include the help function GetWNames() below and replace section 2) by:
'2a) apply ONLY to sheets 1 to 9 ' source sheet has to be included!
ThisWorkbook.Sheets(GetWNames(w,1,9)).FillAcrossSheets rng, xlFillWithAll
Function GetWNames(w As Sheets, first As Long, last As Long)
Dim tmp() As String: ReDim tmp(first To last)
Dim i As Long
For i = first To last
tmp(i) = w(i).Name
Next i
GetWNames = tmp ' return Array(w(1).Name, .. w(last).Name)
'Debug.Print Join(GetWNames, "|")
End Function
Further link
In an older post I demonstrated how to write an array as identical information to all sheets using this method.