Simple VBA to move down one cell, and insert

[ExcelNoob2024]

Hi There

I am new here but have used the board for years to help with things I need to do on Excel. What I need to do is stumping me and I would like a little help please.

I have a sheet that has a Company Name in every Odd Cell Row (1, 3, 5 etc.) and the region they are based in, in every Even Cell Row (2, 4, 6 etc.)

I want to write a simple VBA that would move down to every even cell, shift that cell to the right and then move on until it runs out of cells.

Please can you assist me

Thanks

 

[Joe4]

Welcome to the Board!

Here is one way:

Sub MyMoveCells()

    Dim lr As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through every other row starting in row 2
    For r = 2 To lr Step 2
'       Move cell over to column B
        Cells(r, "B").Value = Cells(r, "A").Value
        Cells(r, "A").ClearContents
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

Here is the before picture:

and here is the data after we run the code: