Copy and Paste

[excelman13]

As you see at the A column, there are some names and numbers belong to these names copied from the Internet. By a macro, I want to write these names and their numbers as you see between C:L horizontally. I have 5-6 thousand names and numbers and it is not easy to do it one by one. If someone writes a macro for this problem, I'll appreciate so much.

Thanks everybody.


excelsoruing.jpeg

[davesexcel]

It may be best to insert a space above the Name using special cells, then copy and paste the rangeAreas.

Sub OhYA()
    Dim LstRw As Long, Rng As Range, c As Range, rw As Long, rN As Long
    Dim RangeArea As Range

    LstRw = Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Range("A2:A" & LstRw).SpecialCells(xlCellTypeConstants, 2)
    Rng.Insert
    
    rN = Cells(Rows.Count, "A").End(xlUp).Row
    For Each RangeArea In Range("A2:A" & rN).SpecialCells(xlCellTypeConstants, 23).Areas
        rw = Cells(Rows.Count, "G").End(xlUp).Row + 1
        RangeArea.Copy
        Cells(rw, "G").PasteSpecial Transpose:=True
    Next RangeArea

End Sub

[excelman13]

It may be best to insert a space above the Name using special cells, then copy and paste the rangeAreas.

Sub OhYA()
    Dim LstRw As Long, Rng As Range, c As Range, rw As Long, rN As Long
    Dim RangeArea As Range

    LstRw = Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Range("A2:A" & LstRw).SpecialCells(xlCellTypeConstants, 2)
    Rng.Insert
    
    rN = Cells(Rows.Count, "A").End(xlUp).Row
    For Each RangeArea In Range("A2:A" & rN).SpecialCells(xlCellTypeConstants, 23).Areas
        rw = Cells(Rows.Count, "G").End(xlUp).Row + 1
        RangeArea.Copy
        Cells(rw, "G").PasteSpecial Transpose:=True
    Next RangeArea

End Sub

Superrrrrrrrrrrrrrrrrrr. It is just how I want. Thanks alot friend.

[mjr veverka]

... or check and adapt the code, from below topic, to your needs:
https://www.excelforum.com/excel-gen...w-entries.html