быстро скопируйте и вставьте формулы

Question

Я пытался написать простой код, который копирует значение из одной ячейки и вставляет его формулу во все ячейки одного столбца (количество ячеек составляет около 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 

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 

End, то вы вставить л в течение первого появления, и вы потеряли данные ,

Это мое предложение.

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