aysam
07-10-2010, 01:02 PM
Peace to you all
I have a macro to insert blank rows after the active cell . ("B6")
for example
It's OK
What I need is
to make the active cell after the insert to be
the first cell after the first active cell ("B7")
my macro is
Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)
' row selection based on active cell
Dim x As Long
Application.EnableEvents = False
If vRows = 0 Then
vRows = Application.InputBox(Prompt:= _
"How many rows do you want to add?", Title:="Add Rows", _
Default:=1, Type:=1) 'Default for 1 row, type 1 is number
If vRows = False Then Exit Sub
End If
Dim sht As Worksheet, shts() As String, i As Integer
ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
Windows(1).SelectedSheets.Count)
i = 0
For Each sht In _
Application.ActiveWorkbook.Windows(1).SelectedSheets
Sheets(sht.Name).Select
i = i + 1
shts(i) = sht.Name
x = Sheets(sht.Name).UsedRange.Rows.Count 'lastcell fixup
Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
Resize(rowsize:=vRows).Insert Shift:=xlDown
'Selection.AutoFill Selection.Resize( _
'rowsize:=vRows + 1), xlFillDefault
On Error Resume Next 'to handle no constants in range
'to remove the non-formulas
Selection.Offset(1).Resize(vRows).EntireRow. _
SpecialCells(xlConstants).ClearContents
Next sht
Worksheets(shts).Select
Application.CalculateFull
Application.EnableEvents = True
End Sub
I have a macro to insert blank rows after the active cell . ("B6")
for example
It's OK
What I need is
to make the active cell after the insert to be
the first cell after the first active cell ("B7")
my macro is
Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)
' row selection based on active cell
Dim x As Long
Application.EnableEvents = False
If vRows = 0 Then
vRows = Application.InputBox(Prompt:= _
"How many rows do you want to add?", Title:="Add Rows", _
Default:=1, Type:=1) 'Default for 1 row, type 1 is number
If vRows = False Then Exit Sub
End If
Dim sht As Worksheet, shts() As String, i As Integer
ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
Windows(1).SelectedSheets.Count)
i = 0
For Each sht In _
Application.ActiveWorkbook.Windows(1).SelectedSheets
Sheets(sht.Name).Select
i = i + 1
shts(i) = sht.Name
x = Sheets(sht.Name).UsedRange.Rows.Count 'lastcell fixup
Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
Resize(rowsize:=vRows).Insert Shift:=xlDown
'Selection.AutoFill Selection.Resize( _
'rowsize:=vRows + 1), xlFillDefault
On Error Resume Next 'to handle no constants in range
'to remove the non-formulas
Selection.Offset(1).Resize(vRows).EntireRow. _
SpecialCells(xlConstants).ClearContents
Next sht
Worksheets(shts).Select
Application.CalculateFull
Application.EnableEvents = True
End Sub