P
plantechbl
I need to Insert Rows and Paste the selected row a specified number of
times per an input box value. I am using the following code as a start
and have commented out the lines to clear the constants and that works
fine except the autofill portion increments the constant values.
Thanks in advance for any help.
This is how I need the result to be:
Room Part#
6 WN1B-24
6 WN1B-24
6 WN1B-24
6 WN1B-24
6 WN1B-24
6 WN1B-24
This is what I am getting:
Room Part#
6 WN1B-24
7 WN1B-25
8 WN1B-26
9 WN1B-27
10 WN1B-28
11 WN1B-29
Sub CopyRows()
' Documented: http://www.mvps.org/dmcritchie/excel/insrtrow.htm
' Re: Insert Rows -- 1997/09/24 Mark Hill <[email protected]>
' row selection based on active cell -- rev. 2000-09-02 David
McRitchie
Dim x As Long
Range("A65536").End(xlUp).Offset(0, 0).Select
ActiveCell.EntireRow.Select 'So you do not have to preselect entire
row
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
'if you just want to add cells and not entire rows
'then delete ".EntireRow" in the following line
'rev. 2001-01-17 Gary L. Brown, programming, Grouped sheets
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 -- John
McKee 2000/02/01
' to remove the non-formulas -- 1998/03/11 Bill Manville
'Selection.Offset(1).Resize(vRows).EntireRow. _
'SpecialCells(xlConstants).ClearContents
Next sht
Worksheets(shts).Select
End Sub
times per an input box value. I am using the following code as a start
and have commented out the lines to clear the constants and that works
fine except the autofill portion increments the constant values.
Thanks in advance for any help.
This is how I need the result to be:
Room Part#
6 WN1B-24
6 WN1B-24
6 WN1B-24
6 WN1B-24
6 WN1B-24
6 WN1B-24
This is what I am getting:
Room Part#
6 WN1B-24
7 WN1B-25
8 WN1B-26
9 WN1B-27
10 WN1B-28
11 WN1B-29
Sub CopyRows()
' Documented: http://www.mvps.org/dmcritchie/excel/insrtrow.htm
' Re: Insert Rows -- 1997/09/24 Mark Hill <[email protected]>
' row selection based on active cell -- rev. 2000-09-02 David
McRitchie
Dim x As Long
Range("A65536").End(xlUp).Offset(0, 0).Select
ActiveCell.EntireRow.Select 'So you do not have to preselect entire
row
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
'if you just want to add cells and not entire rows
'then delete ".EntireRow" in the following line
'rev. 2001-01-17 Gary L. Brown, programming, Grouped sheets
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 -- John
McKee 2000/02/01
' to remove the non-formulas -- 1998/03/11 Bill Manville
'Selection.Offset(1).Resize(vRows).EntireRow. _
'SpecialCells(xlConstants).ClearContents
Next sht
Worksheets(shts).Select
End Sub