Insert Row based on count and copy range to inserted rows
 

Hello,
I am working with the following code that is working fine, I just need some
help to make an adjustment to it as I can't figure it out. At the time of
'Names copied down to the inserted rows' I would like it to copy the values
from the range iRow "A" to iRow "W" to the inserted row instead of just iRow
"A" as it is now.

Thanks for your help.

Sub InsertRowsBasedOnCount()
Dim wks As Worksheet
Dim iRow As Long
Dim HowManyRows As Variant
Dim FirstRow As Long
Dim LastRow As Long

Set wks = Worksheets("Data resolution category")
With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "X").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
HowManyRows = .Cells(iRow, "X").Value
If IsNumeric(HowManyRows) Then
'some minor testing
If HowManyRows 1 _
And HowManyRows < 100 Then
.Rows(iRow + 1).Resize(HowManyRows - 1).Insert
'Names copied down to the inserted rows
.Cells(iRow + 1, "A").Resize(HowManyRows - 1).Value _
= .Cells(iRow, "A").Value

End If
End If
Next iRow
End With

End Sub

Insert Row based on count and copy range to inserted rows
 

Try a change to this portion:
.Cells(iRow + 1, "A").Resize(HowManyRows - 1).Value _
= .Cells(iRow, "A").Value

to:
.Cells(iRow + 1, "A").Resize(HowManyRows - 1, 23).Value _
= .Cells(iRow, "A").Resize(1, 23).Value

The 23 (in both spots!) is the number of columns A:W.

JBG wrote:

Hello,
I am working with the following code that is working fine, I just need some
help to make an adjustment to it as I can't figure it out. At the time of
'Names copied down to the inserted rows' I would like it to copy the values
from the range iRow "A" to iRow "W" to the inserted row instead of just iRow
"A" as it is now.

Thanks for your help.

Sub InsertRowsBasedOnCount()
Dim wks As Worksheet
Dim iRow As Long
Dim HowManyRows As Variant
Dim FirstRow As Long
Dim LastRow As Long

Set wks = Worksheets("Data resolution category")
With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "X").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
HowManyRows = .Cells(iRow, "X").Value
If IsNumeric(HowManyRows) Then
'some minor testing
If HowManyRows 1 _
And HowManyRows < 100 Then
.Rows(iRow + 1).Resize(HowManyRows - 1).Insert
'Names copied down to the inserted rows
.Cells(iRow + 1, "A").Resize(HowManyRows - 1).Value _
= .Cells(iRow, "A").Value

End If
End If
Next iRow
End With

End Sub

--

Dave Peterson

Insert Row based on count and copy range to inserted rows
 

Thanks Dave. That worked perfectly.

"Dave Peterson" wrote:

Try a change to this portion:
.Cells(iRow + 1, "A").Resize(HowManyRows - 1).Value _
= .Cells(iRow, "A").Value

to:
.Cells(iRow + 1, "A").Resize(HowManyRows - 1, 23).Value _
= .Cells(iRow, "A").Resize(1, 23).Value

The 23 (in both spots!) is the number of columns A:W.

JBG wrote:

Hello,
I am working with the following code that is working fine, I just need some
help to make an adjustment to it as I can't figure it out. At the time of
'Names copied down to the inserted rows' I would like it to copy the values
from the range iRow "A" to iRow "W" to the inserted row instead of just iRow
"A" as it is now.

Thanks for your help.

Sub InsertRowsBasedOnCount()
Dim wks As Worksheet
Dim iRow As Long
Dim HowManyRows As Variant
Dim FirstRow As Long
Dim LastRow As Long

Set wks = Worksheets("Data resolution category")
With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "X").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
HowManyRows = .Cells(iRow, "X").Value
If IsNumeric(HowManyRows) Then
'some minor testing
If HowManyRows 1 _
And HowManyRows < 100 Then
.Rows(iRow + 1).Resize(HowManyRows - 1).Insert
'Names copied down to the inserted rows
.Cells(iRow + 1, "A").Resize(HowManyRows - 1).Value _
= .Cells(iRow, "A").Value

End If
End If
Next iRow
End With

End Sub

--

Dave Peterson