快速复制和粘贴公式

Question

我一直在尝试编写一个简单的代码，从一个单元格复制值并将其公式粘贴到一列中的所有单元格中（有几个单元格，大约 3000 个）。该代码可以工作，但运行时间大约需要 30 分钟，所以对我来说不太好。我也尝试过让公式的值不带“=”然后使用替换命令，但是效果也不好。任何人都可以帮助我在 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

Answer 1

告诉我这是否对你有帮助......

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