I need your help...

I really new in Macros. I want to find the last row of each Alphabet and then duplicate the whole row. I hope this is possible. If you see in the picture, the last row of A is row Nr. 8. so I want to duplicate this row, and insert it on row Nr.9. The last row of B is Nr. 15, so I want to duplicate it and insert into row nr. 16, and so on....

CodePudding user response：

It is possible with many ways. One of the ways is FOR LOOP.

Code:

Sub Add_dup()  
Set Rng = Application.InputBox("Select the range of cells", , , , , , , 8)

startrow = Rng.Row
startcol = Rng.Column
counter = 0

For i = startrow   1 To Rng.Rows.Count   startrow   counter   Rng.Rows.Count   startrow
    For j = startcol To Rng.Columns.Count   startcol - 1
       If Cells(i, j) <> Cells(i - 1, j) Then
            Cells(i, j).EntireRow.Insert
            Range(Cells(i - 1, j - 3), Cells(i - 1, j)).Copy Range(Cells(i, j - 3), Cells(i, j))
            
            'Uncomment the below line to get the newly added rows highlighted
            'Range(Cells(i, j - 3), Cells(i, j)).EntireRow.Interior.ColorIndex = 6
            i = i   1
            counter = counter   1
        End If
    Next j
Next i

lastrow = Rng.Rows.Count   startrow
Range(Cells(lastrow - 1, startcol - 3), Cells(lastrow - 1, startcol)).Copy Range(Cells(lastrow, startcol - 3), Cells(lastrow, startcol))

End Sub

Usage:

• Since we are asking the range from user, macro will initially prompt you the range
• Select the range from start till end of the column (in your case, you need to select D3 to D31)
• Note: This macro will work if you select 1 column only (in your case only Kommentar_1)