Vba 快速复制和粘贴公式

我一直在尝试编写一个简单的代码，从一个单元格复制值，并将其公式粘贴到一列中的所有单元格中。有几个单元格，大约3000个。代码可以运行，但运行大约需要30分钟，所以对我来说不合适。我还尝试让公式的值不带=，然后使用replace命令，但它不起作用。谁能帮我在1分钟内运行宏？这是我试图做到的代码部分：

sub copy_paste

Worksheets("Formatar").Range("H1:L1").Copy
Worksheets("Formatar").Range("H3").PasteSpecial xlValue
Worksheets("Formatar").Range("H3:L3").Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial xlFormulas

end sub

---

告诉我这是否对你有帮助

Sub copy_paste()
    Worksheets("Formatar").Range("H1:L1").Copy 'Copy from row 1
    Worksheets("Formatar").Range("H3").PasteSpecial xlPasteValues 'paste the values to row 3
    Worksheets("Formatar").Range("H3:L3").Copy 'here you copy that (the values) 
    Range(Selection, Selection.End(xlDown)).Select you select eveything from row3 
    Selection.PasteSpecial xlPasteValues 'and paste it... but you copy just values from 3! 
End Sub

然后将其粘贴到第一次出现时，数据就会丢失

这是我的建议

Sub copy_paste()
    Dim sht As Worksheet
    Dim r
    Dim H
    Dim L
    
    Set sht = Sheets("Formatar") 'store the sheet
    
    sht.Activate 'activate it!
    Range("H1:L1").Copy
    Range("H3").PasteSpecial xlPasteFormulas 'Paste the formula
    Range("H3:L3").Copy 'then copy again
    
    H = Range("H1").Column 'Just to take the number of the columns H and L
    L = Range("L1").Column
    
    r = Range("H3").End(xlDown).Row - 1 'Take the number of the last blank row.
    Range(Cells(3, H), Cells(r, L)).PasteSpecial xlPasteValues
    'Here you paste values, of if you need the
    'formula use this: xlPasteFormulas
    Application.CutCopyMode = False 'never forget this...
End Sub

编辑

也许这会有帮助

'Application.Calculation = xlManual



Sub copy_paste()
    Dim sht As Worksheet
    Dim r
    Dim H
    Dim L
    
    Set sht = Sheets("Formatar") 'store the sheet
    
    sht.Activate 'activate it!
    Range("H1:L1").Copy
    Range("H3").PasteSpecial xlPasteFormulas 'Paste the formula
    Application.Calculation = xlManual 'Not automatic calculation
    Range("H3:L3").Copy 'then copy again
    
    H = Range("H1").Column 'Just to take the number of the columns H and L
    L = Range("L1").Column
    
    r = Range("H3").End(xlDown).Row - 1 'Take the number of the last blank row.
    Range(Cells(3, H), Cells(r, L)).PasteSpecial xlPasteValues
    'Here you paste values, of if you need the
    'formula use this: xlPasteFormulas
    Application.CutCopyMode = False 'never forget this...
    Calculate 'Calculate the whole sheet
    Application.Calculation = xlCalculationAutomatic 'return automatic calculation
End Sub

---

它可能有助于实际显示您填写的公式或合理的传真。公式的结果是静态的还是经常变化的？运行此程序时，H列中有什么内容？如果从H4开始为空，则实际上填充了超过一百万行。在代码中，复制的是单元格的值，而不是公式。从H1：L1复制到H3，在这里粘贴值，然后复制值，并将其从H3:L3粘贴到空白单元格的末尾，使用…xlFormulas！？！？！。。。让我来回答……谢谢你，埃尔伯特，但当我使用我需要的公式时，仍然需要很长时间。你有什么建议可以在更短的时间内完成吗？嗯，很难说什么，因为我需要查看整个文件，公式，纸张大小，纸张数量，以及计算机的种类，有时这些问题会影响执行速度。