With Sheets("Sheet1")
    'get last row of col A
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    'move second value
    For i = 1 To lr Step 3
        .Cells(i, 2).Value = .Cells(i + 1, 1).Value
    Next i
    'remove rows where B is blank
    .Range("B1:B" & lr).SpecialCells(xlBlanks).EntireRow.Delete
End With