JayJay6
03-08-2012, 05:12 AM
Hi people,
I have made a macro (below) which copy a row with formulars and paste it below, deleting the values in specified columns.
If the "Activecell" is not in column A, the msgbox pops up.
The Macro works fine as long as I do not protect the sheet, but if I lock specific cells and protect the sheet I get the following Run-time error:
"Run-time error '1004': Insert method of Range class failed"
As you can see in the script, I unprotect the sheet before the script is run, but it doesn't help ?:(
Any suggestions are more than welcome.
Br,
Jakob
Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
Dim InterSectRange As Range
Set InterSectRange = Application.Intersect(Range1, Range2)
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
End Function
Sub Insert_Row()
Sheet1.Unprotect Password:="PW"
If InRange(ActiveCell, Range("A:A")) Then
ActiveCell.EntireRow.Select
Selection.Copy
ActiveCell.EntireRow.Insert
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range(ActiveCell, ActiveCell.Offset(0, 6)).ClearContents
ActiveCell.Offset(0, 14).Select
Range(ActiveCell, ActiveCell.Offset(0, 3)).ClearContents
ActiveCell.Offset(0, 10).Select
ActiveCell.ClearContents
ActiveCell.Offset(0, -24).Select
Else
MsgBox "NOTE: You need to place cursor in the first column (column A)!"
End If
Sheet1.Protect Password:="PW"
End Sub
I have made a macro (below) which copy a row with formulars and paste it below, deleting the values in specified columns.
If the "Activecell" is not in column A, the msgbox pops up.
The Macro works fine as long as I do not protect the sheet, but if I lock specific cells and protect the sheet I get the following Run-time error:
"Run-time error '1004': Insert method of Range class failed"
As you can see in the script, I unprotect the sheet before the script is run, but it doesn't help ?:(
Any suggestions are more than welcome.
Br,
Jakob
Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
Dim InterSectRange As Range
Set InterSectRange = Application.Intersect(Range1, Range2)
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
End Function
Sub Insert_Row()
Sheet1.Unprotect Password:="PW"
If InRange(ActiveCell, Range("A:A")) Then
ActiveCell.EntireRow.Select
Selection.Copy
ActiveCell.EntireRow.Insert
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range(ActiveCell, ActiveCell.Offset(0, 6)).ClearContents
ActiveCell.Offset(0, 14).Select
Range(ActiveCell, ActiveCell.Offset(0, 3)).ClearContents
ActiveCell.Offset(0, 10).Select
ActiveCell.ClearContents
ActiveCell.Offset(0, -24).Select
Else
MsgBox "NOTE: You need to place cursor in the first column (column A)!"
End If
Sheet1.Protect Password:="PW"
End Sub