Inserting Lines And Copying Them

[Troyk]

Hi fellow Excel users,

I got the following problem:
I would like to insert the amount of lines specified in colomn "m".
This works fine. But i would also like to copy the lines . So when the
For loop detects a number like 3 , he has to insert 3 new lines and
copy the values from the line which had the value 3 somewhere in it's
row.

Now my code only inserts the amount of lines specified in "m".

My code:
Sub voegin()
Dim lastrow As Long
Dim row_index As Long



lastrow = ActiveSheet.Cells(Rows.Count, "m").End(xlUp).Row
For row_index = lastrow - 1 To 1 Step -1
If LCase(Cells(row_index + 1, "m").Value) = "1" Then
Cells(row_index + 1, "m").EntireRow.Insert _
(xlShiftUp)
ElseIf LCase(Cells(row_index + 1, "m").Value) = "2" Then
Cells(row_index + 1, "m").Resize(2, 1).EntireRow.Insert _
(xlShiftUp)
ElseIf LCase(Cells(row_index + 1, "m").Value) = "3" Then
Cells(row_index + 1, "m").Resize(3, 1).EntireRow.Insert _
(xlShiftUp)
ElseIf LCase(Cells(row_index + 1, "m").Value) = "4" Then
Cells(row_index + 1, "m").Resize(4, 1).EntireRow.Insert _
(xlShiftUp)
ElseIf LCase(Cells(row_index + 1, "m").Value) = "5" Then
Cells(row_index + 1, "m").Resize(5, 1).EntireRow.Insert _
(xlShiftUp)
ElseIf LCase(Cells(row_index + 1, "m").Value) = "6" Then
Cells(row_index + 1, "m").Resize(6, 1).EntireRow.Insert _
(xlShiftUp)
ElseIf LCase(Cells(row_index + 1, "m").Value) = "7" Then
Cells(row_index + 1, "m").Resize(7, 1).EntireRow.Insert _
(xlShiftUp)
ElseIf LCase(Cells(row_index + 1, "m").Value) = "8" Then
Cells(row_index + 1, "m").Resize(8, 1).EntireRow.Insert _
(xlShiftUp)
ElseIf LCase(Cells(row_index + 1, "m").Value) = "9" Then
Cells(row_index + 1, "m").Resize(9, 1).EntireRow.Insert _
(xlShiftUp)
End If
Next
End Sub

Does anybody know how i get the code to copy the lines as well?

 

[Bernie Deitrick]

Troy,

Simply do the copy prior to the insert. Also, you can use the value in the
cell as a variable, so no need for the select case structure:

Sub voegin2()
Dim lastrow As Long
Dim row_index As Long
Dim myCnt As Integer

lastrow = ActiveSheet.Cells(Rows.Count, "m").End(xlUp).Row
For row_index = lastrow - 1 To 1 Step -1
myCnt = CInt(Cells(row_index + 1, "m").Value)
Cells(row_index + 1, "m").EntireRow.Copy
Cells(row_index + 1, "m").Resize(myCnt, 1).EntireRow.Insert
Application.CutCopyMode = False
Next
End Sub

HTH,
Bernie
MS Excel MVP