MACRO aggiungere riga e copiare solo formula

[marnevi]

Ragazzi, la macro seguente mi consente di aggiungere una riga sotto quella selezionata. Essa mi copia la formattazione della riga di origine selezionata ma vorrei che, della stessa riga, mi copiasse SOLO LE CELLE che contengono una formula.

Codice: Seleziona tutto

Public Sub insertRowBelow()
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End Sub

Avevo pensato di inserire in una cella inutilizzata del foglio la formula che mi interessa. Dopodiché, implementare la mia macro con dei comandi in grado di copiare la cella contenente la formula e di incollarla alla cella della nuova riga che la macro mi aggiunge automaticamente.

Così operando, come si riscrive la macro di sopra?

[Anthony47]

Prova questa variante:

Codice: Seleziona tutto

Public Sub insertRowBelow2()
myrow = ActiveCell.Row
Cells(myrow + 1, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove
Cells(myrow, 1).EntireRow.Copy Cells(myrow + 1, 1)
Cells(myrow + 1, 1).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents
Application.CutCopyMode = False
End Sub

Ciao

[marnevi]

L'unico (dico l'unico) nel web che è riuscito a darmi una soluzione (e anche semplice).... Grazie Anthony

[Anthony47]

"Unici nel web" mi sembra esagerato e ci fa arrossire, diciamo che siamo tra i piu' belli e i piu' disponibili ...
Alla prossima!

[marnevi]

Anthony... devo disturbati un altra volta. La tua macro funziona. Ma in un caso no. Ho notato che se nella riga di origine non c'è nemmeno una cella con valori (ma solo con formule) viene generato un errore 1004 alla riga:

Codice: Seleziona tutto

Cells(myrow + 1, 1).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents

come posso ovviare il difetto?

[Anthony47]

Grrrr... anche ai piu' belli sfuggono dei particolari...
Questa variante della variante dovrebbe andare:

Codice: Seleziona tutto

Public Sub insertRowBelow2()
myrow = ActiveCell.Row
Cells(myrow + 1, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove
Cells(myrow, 1).EntireRow.Copy Cells(myrow + 1, 1)
On Error Resume Next
    Cells(myrow + 1, 1).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents
On Error GoTo 0
Application.CutCopyMode = False
End Sub


Ciao

[marnevi]

funziona...GRANDE