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]

Does your explanation mean that you want to copy two cells in Columns AE:AF, if the cell in Column AF has a value, and insert these two cells into AH:AI in the same Row?

Upload a mini sheet with before and after would be a good idea.

 

[Busscheduler]

I would like to copy three cells in AE,AF and AG, if column AF has a value and insert them into AH in the same row. AH would have other data which would be shifted down for the insert.

My apologies for not being able to upload a sheet. I am doing this with my cell.

 

[jolivanes]

If I am remotely close to understanding your requirement, this might be what you're after.
Change references if and where required. I also assume you know the "golden" rule. Try on a copy of your original.

Sub Maybe()
Dim i As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 32).End(xlUp).Row To IIf(Cells(2, 32) <> "", 2, Cells(1, 32).End(xlDown).Row) Step -1
    If Len(Cells(i, 32)) <> 0 Then
        With Cells(i, 31)
            .Resize(, 3).Copy
            .Offset(, 3).Insert Shift:=xlDown
        End With
    End If
Next i
Application.ScreenUpdating = True
End Sub

 

[Busscheduler]

Yes, I have learned the hard way about not using a copy of the original sheet. I will try this as soon as I get back home and let you know how it worked. Thanks.

 

[Busscheduler]

jolivanes, your code worked perfectly. Thanks so much for your help. I am marking this as solved.

 

[Busscheduler]

jolivanes, here is the sheet to show you what the code did. Again, it worked perfectly to give me the result I was looking for. Thanks again.

Copy of TUI - Departures - 4-11-22 (20220406).xls
	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN
1	Time
2	BUS 1 (16)	10:35	Clarion Lake Buena Vista	BUS 1 (16)	10:35	Clarion Lake Buena Vista
3				FOWLER - 90050 - Party of 4
4		11:00	Disney's All Star Music Resort	N. Alexander - 87677 - Party of 6
5					11:00	Disney's All Star Music Resort
6	BUS 2 (34)	10:50	Coco Key Hotel and Water Park Resort	L. BENBOW - 87672 - Party of 3
7				T. Gibbon - 88298 - Party of 3
8				BUS 2 (34)	10:50	Coco Key Hotel and Water Park Resort
9		10:55	Rosen Inn International	H. Mcgowan - 87684 - Party of 4
10				A. Loveridge - 87909 - Party of 2
11				T. Gambiza - 88308 - Party of 2
12		11:05	Sonesta ES Suites Orlando		10:55	Rosen Inn International
13		11:15	Rosen Inn Pointe Orlando	A. Grayson - 87682 - Party of 5
14				D. Thomson - 87904 - Party of 3
15				S. ****er - 87683 - Party of 2
16		11:20	Ramada Plaza Resort and Suites International Drive		11:05	Sonesta ES Suites Orlando
17				MORRIS - 89407 - Party of 2
18	BUS 3 (24)	11:10	The Avanti Resort		11:15	Rosen Inn Pointe Orlando
19				C. Baines - 87688 - Party of 2
20		11:15	Universal's Endless Summer Resort	K. Eckersley - 87911 - Party of 4
21				K. Graham - 87659 - Party of 4
22					11:20	Ramada Plaza Resort and Suites International Drive
23				M. HARRIS - 88431 - Party of 2
24				S. newham - 88577 - Party of 2
25	BUS 4 (16)	12:50	Disney's Caribbean Beach	BUS 3 (24)	11:10	The Avanti Resort
26		13:10	Clarion Lake Buena Vista	K. Bernardi - 87657 - Party of 6
27		13:30	Disney's Coronado Springs Resort	P. Rennison - 87902 - Party of 4
28					11:15	Universal's Endless Summer Resort
29	BUS 5 (25)	13:25	Rosen Inn International	A. Browning - 87709 - Party of 4
30				D. Forbes - 87912 - Party of 4
31		13:35	Sonesta ES Suites Orlando	S. Lindner - 88253 - Party of 2
32		13:40	Rosen Inn Pointe Orlando	T. Christopher - 88307 - Party of 4
33		13:45	Ramada Plaza Resort and Suites International Drive
34				BUS 4 (16)	12:50	Disney's Caribbean Beach
35				P. Newton - 88256 - Party of 5
36	BUS 6 (19)	13:40	Loews Royal Pacific Resort at Universal Orlando		13:10	Clarion Lake Buena Vista
37		13:45	Universal's Endless Summer Resort	E. Kelly - 88239 - Party of 3
38					13:30	Disney's Coronado Springs Resort
39				J. Quinn - 88002 - Party of 4
40		13:50	Rosen Shingle Creek	M. Williams - 87988 - Party of 4
41				BUS 5 (25)	13:25	Rosen Inn International
42				L. Norris - 87987 - Party of 3
43				S. Glover - 88305 - Party of 4
44					13:35	Sonesta ES Suites Orlando
45				M. BOWEN - 87658 - Party of 4
46					13:40	Rosen Inn Pointe Orlando
47				J. Kenney - 87786 - Party of 2
48					13:45	Ramada Plaza Resort and Suites International Drive
49				A. Lopez - 87696 - Party of 4
50				E. Lawrence - 88824 - Party of 4
51				K. Doughty - 89822 - Party of 4
52				BUS 6 (19)	13:40	Loews Royal Pacific Resort at Universal Orlando
53				J. Cousins - 87961 - Party of 3
54					13:45	Universal's Endless Summer Resort
55				A. Barritt - 88295 - Party of 4
56				E. tranter - 89193 - Party of 5
57				S. Selby - 88309 - Party of 5
58					13:50	Rosen Shingle Creek
59				H. Payne - 87676 - Party of 2
60
Sheet0 (4)

 

[jolivanes]

Thanks for letting us know that you're happy with it and good luck.

 

[Busscheduler]

jolivanes, might you help with one more item? I am trying to copy a column of data that has formulas in it and paste it as values. I tried several renditions of the following code with no luck:

.PasteSpecial xlPasteValues

Here is the line of code that I am trying to paste values with:

Cells(r - 1, "V").Copy Cells(r - 1, "AH")

I know that there is a line of code that will ignore formulas and only paste values but I just can't get it to work. Thanks.

Here is the entire code:

Sub Tui()
 Dim lr As Long, r As Long, x As Integer
 Application.ScreenUpdating = False
 lr = Cells(Rows.Count, "R").End(xlUp).Row
     Cells(2, "R").Copy Cells(2, "Af")
     Cells(2, "T").Copy Cells(2, "AE")
     Cells(2, "S").Copy Cells(2, "AG")
 For r = 3 To lr + 1
    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")
 
 Next r
 
 Dim i As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 32).End(xlUp).Row To IIf(Cells(2, 32) <> "", 2, Cells(1, 32).End(xlDown).Row) Step -1
    If Len(Cells(i, 32)) <> 0 Then
        With Cells(i, 31)
            .Resize(, 3).Copy
            .Offset(, 3).Insert Shift:=xlDown
        End With
    End If
Next i
Application.ScreenUpdating = True
 
 
 
End Sub

 

[jolivanes]

Is this what you're referring to?

Cells(r-1, "AH").Value = Cells(r-1, "V").Value