Formül Sonucu Getirme

[petsiye]

Merhaba,

Hazırlamış olduğum Excel dosyasında, aşağıdaki tarzda yüzlerce formül var. Bu formülü ben, altındaki satırlara önce Formülleri yapıştır, sonra değerleri yapıştır şeklinde çoğaltıyorum. Fakat bunun kestirme bir kod şeklinde yazımı mümkünmüdür ?

Yardımcı olabileceklere şimdiden çok Teşekkür Ederim.

Range("JVM3").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(IF(FILTRE!RC[-7319]>AVERAGEIFS(FILTRE!R3C26:FILTRE!R1800C26,FILTRE!R3C21:FILTRE!R1800C21,FILTRE!RC[-7324]),""VAR"",""""),"""")"

Range("JVM3").Select
Selection.Copy
Application.Goto Reference:="R2000C7345"
Range("JVM2000:JVM2000").Select
Range("JVM3:JVM2000").Select
Range("JVM2000").Activate
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Application.Calculation = xlAutomatic
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.Calculation = xlManual

 

[muhasebeciyiz]

Sub CopyFormulasAndValues()
Dim lastRow As Long
Dim formulaRange As Range
Dim pasteRange As Range

Range("JVM3").FormulaR1C1 = _
"=IFERROR(IF(FILTRE!RC[-7319]>AVERAGEIFS(FILTRE!R3C26:FILTRE!R1800C26,FILTRE!R3C21:FILTRE!R1800C21,FILTRE!RC[-7324]),""VAR"",""""),"""")"

lastRow = 2000 ' İhtiyacınıza göre bu satırı düzenleyin

Set formulaRange = Range("JVM3")
Set pasteRange = Range("JVM4:JVM" & lastRow)

formulaRange.Copy
pasteRange.PasteSpecial Paste:=xlPasteFormulas

pasteRange.Copy
pasteRange.PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False
Application.Calculation = xlAutomatic
End Sub

Formül, ilk başta JVM3 hücresine yazılıyor.
JVM3 hücresindeki formül, belirtilen aralığa (örneğin, JVM4:JVM2000) kopyalanıyor
Daha sonra değer olarak yapıştırılıyor

Denermisiniz.

 

[petsiye]

Sayın @muhasebeciyiz ,

Evet kod sorunsuz, çok teşekkür ederim. Fakat aradığım biraz daha kestirme bir ifade şekli. Bunun gibi yüzlerce formül var yapının içinde.