Help with a macro to copy adjacent cells

[Busscheduler]

Hi, I’m working on a macro to copy and paste different cells:

Cells(rows.count, “AF”). End(xlup).select
Active cell. Offset(0,-1).select

I have the macro finding the last cell in column AF, coming back up to the first cell with data and then moving one cell to the left “AE” and selecting that cell. I need it to copy cells AE:AG of that row and insert that into AH and shift the cells down to insert. I need it to loop through the rows from bottom to top and do this for each row, if cells in AF have data in them.

Thanks for any help I can get on this. I just can’t find the right code to make all of this happen in the short time I have to get this done.

 

[jolivanes]

You can change this

Cells(2, "R").Copy Cells(2, "Af")
Cells(2, "T").Copy Cells(2, "AE")
Cells(2, "S").Copy Cells(2, "AG")

to this

With Cells(2, 18)
.Offset(, 14).Value = .Value
.Offset(, 15).Value = .Offset(, 1).Value
.Offset(, 13).Value = .Offset(, 2).Value
End With

and this

If Cells(r, "S") <> Cells(r - 1, "S") Then
'if cell 3 in column s is not equal to cell 2 in column s
Cells(r, "R").Copy Cells(r, "AF")
'copy cell 3 in column R and paste it into column AF
Cells(r, "S").Copy Cells(r, "AG")
'also copy column s and paste into column AG
Cells(r, "T").Copy Cells(r, "AE")
End If
Cells(r - 1, "V").Copy Cells(r - 1, "AH")

to this

With Cells(r, 19)
If .Value <> .Offset(-1).Value Then
.Offset(, 13).Value = .Offset(, -1).Value
.Offset(, 14).Value = .Value
.Offset(, 12).Value = .Offset(, 1).Value
.Offset(-1, 15).Value = .Offset(-1, 1).Value
End If
End With

Check all the cell references after trying it on a copy of your workbook.

 

[Busscheduler]

jolivanes, I took the code replacements and ran the macro and it worked perfectly and the code looks really sleek with those replacements. Thanks for that.

 

[jolivanes]

Glad it worked as advertised.
Good Luck