Y
yonasan
I have a macro that works fine in excel 2007 but not 2010. It crashe
when I try to insert a row, and then if I try to insert it myself, i ge
the error message: "Cannot shift object off sheet."
here is the code:
Sub Synthese2(an1, an2, an5, LMainWB, LNewWB)
Dim Row, Row1, Row2, n, Col As Integer
Dim LNewWB2 As String
Call Module1.Copiervalue("Feuil1", "NomSc", "Exec Summary", "NomS")
Call Module1.Copiervalue("Feuil1", "_Sc2", "Exec Summary"
"Scoller2")
Call Module1.Copiervalue("Feuil1", "_Sc3", "Exec Summary"
"Scoller3")
Call Module1.Copiervalue("Feuil1", "_Sc4", "Exec Summary"
"Scoller4")
Call Module1.Copiervalue("Feuil1", "_Sc5", "Exec Summary"
"Scoller5")
Sheets("Exec Summary").Select
Application.Goto Reference:="A.Exercice"
ActiveCell.FormulaR1C1 = an1
If an5 <> CStr(0) Then
n = an1 - an2 - 1
Application.Goto Reference:="_Ref1"
Row1 = Application.ActiveCell.Row
Range("A" & CStr(Row1 + 1) & ":C" & CStr(Row1 + 3)).Select
Selection.Cut
Workbooks.Add
ActiveSheet.Paste
ActiveWindow.Close SaveChanges:=False
Range("A" & CStr(Row1 + 1) & ":C" & CStr(Row1 + 3)).Select
Selection.Delete Shift:=xlUp
Windows(LNewWB).Activate
Sheets("Exec Summary").Select
Application.Goto Reference:="_Ref2"
Rown = Application.ActiveCell.Row
Sheets("Exec Summary").Range("A" & CStr(Rown - an5) & ":C"
CStr(Rown - 1)).Select
Selection.Copy
Windows(LMainWB).Activate
Sheets("Exec Summary").Select
Application.Goto Reference:="Ref"
Row = Application.ActiveCell.Row
Selection.Insert Shift:=xlDown // this is where the macro crashes
Windows(LNewWB).Activate
Sheets("Exec Summary").Select
Sheets("Exec Summary").Range("A" & CStr(Rown - an5) & ":A"
CStr(Rown - 1)).Select
Selection.Copy
Windows(LMainWB).Activate
Sheets("Exec Summary").Select
Sheets("Exec Summary").Range("A" & CStr(Row)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
For i = 0 To an5
Sheets("Exec Summary").Rows(CStr(Row1 + 1 + i) & ":" & CStr(Row1 +
+ i)).RowHeight = 350
Next i
Application.Goto Reference:="_Ref2"
Selection.Rows.AutoFit
If n > 0 Then
For i = 1 To n
Call Synthese.Cut
Next i
End If
End If
End Su
when I try to insert a row, and then if I try to insert it myself, i ge
the error message: "Cannot shift object off sheet."
here is the code:
Sub Synthese2(an1, an2, an5, LMainWB, LNewWB)
Dim Row, Row1, Row2, n, Col As Integer
Dim LNewWB2 As String
Call Module1.Copiervalue("Feuil1", "NomSc", "Exec Summary", "NomS")
Call Module1.Copiervalue("Feuil1", "_Sc2", "Exec Summary"
"Scoller2")
Call Module1.Copiervalue("Feuil1", "_Sc3", "Exec Summary"
"Scoller3")
Call Module1.Copiervalue("Feuil1", "_Sc4", "Exec Summary"
"Scoller4")
Call Module1.Copiervalue("Feuil1", "_Sc5", "Exec Summary"
"Scoller5")
Sheets("Exec Summary").Select
Application.Goto Reference:="A.Exercice"
ActiveCell.FormulaR1C1 = an1
If an5 <> CStr(0) Then
n = an1 - an2 - 1
Application.Goto Reference:="_Ref1"
Row1 = Application.ActiveCell.Row
Range("A" & CStr(Row1 + 1) & ":C" & CStr(Row1 + 3)).Select
Selection.Cut
Workbooks.Add
ActiveSheet.Paste
ActiveWindow.Close SaveChanges:=False
Range("A" & CStr(Row1 + 1) & ":C" & CStr(Row1 + 3)).Select
Selection.Delete Shift:=xlUp
Windows(LNewWB).Activate
Sheets("Exec Summary").Select
Application.Goto Reference:="_Ref2"
Rown = Application.ActiveCell.Row
Sheets("Exec Summary").Range("A" & CStr(Rown - an5) & ":C"
CStr(Rown - 1)).Select
Selection.Copy
Windows(LMainWB).Activate
Sheets("Exec Summary").Select
Application.Goto Reference:="Ref"
Row = Application.ActiveCell.Row
Selection.Insert Shift:=xlDown // this is where the macro crashes
Windows(LNewWB).Activate
Sheets("Exec Summary").Select
Sheets("Exec Summary").Range("A" & CStr(Rown - an5) & ":A"
CStr(Rown - 1)).Select
Selection.Copy
Windows(LMainWB).Activate
Sheets("Exec Summary").Select
Sheets("Exec Summary").Range("A" & CStr(Row)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
For i = 0 To an5
Sheets("Exec Summary").Rows(CStr(Row1 + 1 + i) & ":" & CStr(Row1 +
+ i)).RowHeight = 350
Next i
Application.Goto Reference:="_Ref2"
Selection.Rows.AutoFit
If n > 0 Then
For i = 1 To n
Call Synthese.Cut
Next i
End If
End If
End Su