Inserting Lines And Copying Them
 

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?

Inserting Lines And Copying Them
 

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 structu

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

"Troyk" wrote in message
m...
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?