Insert rows and copy transpose

[PMARI]

Dear All,

My requirement as given below,

Having XL sheet with Name and four address columns.

Need to insert 4 rows below each name and respective copy 4 address cells and paste (Transpose ) below name.
Repeat this action till entry in col ”A”

Name	Add1	Add2	Add3	Add4
AAAAA	Add1	Add2	Add3	Add4
BBBB	Add1	Add2	Add3	Add4
Base File

<tbody>
</tbody>

Name	Add1	Add2	Add3	Add4
AAAAA	Add1	Add2	Add3	Add4
Add1
Add2
Add3
Add4
BBBB	Add1	Add2	Add3	Add4
Add1
Add2
Add3
Add4
My Macro ' Macro4 Macro ' ' Rows("3:6").Select Selection.Insert Shift:=xlDown Range("B2:E2").Select Selection.Copy Range("A3").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Rows("8:11").Select Application.CutCopyMode = False Selection.Insert Shift:=xlDown Range("B7:E7").Select Selection.Copy Range("A8").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True End Sub Please revert. Thanks in advance.

<tbody>
</tbody>

 

[gallen]

So what issue is there with your code?

 

[gallen]

This does as you ask though it seems strange to have the address details twice as per your example

Sub InsertRowsAndTranspose()

    'Assuming data starts in A2 and spans to E2 and there are no blank rows.
    Dim lNameRow As Long 'row number of next name
    
    lNameRow = 2 'first row of data
    
    Do
        'insert 4 rows
        Rows(lNameRow + 1 & ":" & lNameRow + 4).Insert Shift:=xlDown
        'copy address cells
        Range("B" & lNameRow & ":E" & lNameRow).Copy
        'paste address cells and transpose
        Range("A" & lNameRow + 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        'go to next row below
        lNameRow = lNameRow + 5
        'Keep looping until we hit blank row
    Loop Until Len(Range("A" & lNameRow)) = 0
    
End Sub