Loop thru series to copy and paste with an offset using VBA code

[LtCmdrData]

I have some trip data in a subtotal form. I use this to calculate miles based on zip codes (columns E & H). I need to copy and paste the first Dest Postal code so it becomes the second Origin Postal code. I need it to move down the page doing this but start over with each new Lane ID (column A). This will allow me to calculate the in between miles. The results should look like the second image. Can someone help me with this task? Thank you.

LANE ID	Stop#	Origin City	Origin State	Origin Postal	Dest City	Dest State	Dest Postal
1​	1​			37202​			21001
1​	2​			37202​			14227
1 Count							2​
10​	1​			37202​			24210
10​	2​			37202​			30080
10​	3​			37202​			36201
10​	4​			37202​			36201
10​	5​			37202​			36801
10​	6​			37202​			32033
10 Count							6​
100​	1​			37202​			85193
100​	2​			37202​			90670
100​	3​			37202​			95206
100​	4​			37202​			97220
100 Count						4​
101​	1​			37202​			98531
101​	2​			37202​			92618
101 Count						2​
102​	1​			37202​			98531
102​	2​			37202​			97220
102​	3​			37202​			91761
102 Count						3​
103​	1​			37202​			98531
103​	2​			37202​			97071
103 Count						2​
104​	1​			37202​			98531
104 Count						1​
105​	1​			37202​			85226
105​	2​			37202​			85043
105​	3​			37202​			95206
105​	4​			37202​			95206
105 Count						4​
106​	1​			37202​			50049
106​	2​			37202​			61081
106 Count						2​
107​	1​			37202​			50049
107 Count						1​
108​	1​			37202​			14227
108​	2​			37202​			21001
108 Count						2​

LANE ID	Stop#	Origin City	Origin State	Origin Postal	Dest City	Dest State	Dest Postal
1​	1​			37202			21001
1​	2​			21001			14227
1 Count							2​
10​	1​			37202			24210
10​	2​			24210			30080
10​	3​			30080			36201
10​	4​			36201			36201
10​	5​			36201			36801
10​	6​			36801			32033
10 Count							6​
100​	1​			37202			85193
100​	2​			85193			90670
100​	3​			90670			95206
100​	4​			95206			97220
100 Count						4​
101​	1​			37202			98531
101​	2​			98531			92618
101 Count						2​
102​	1​			37202			98531
102​	2​			98531			97220
102​	3​			97220			91761
102 Count						3​
103​	1​			37202			98531
103​	2​			98531			97071
103 Count						2​
104​	1​			37202			98531
104 Count						1​
105​	1​			37202			85226
105​	2​			85226			85043
105​	3​			85043			95206
105​	4​			95206			95206
105 Count						4​
106​	1​			37202			50049
106​	2​			50049			61081
106 Count						2​
107​	1​			37202			50049
107 Count						1​
108​	1​			37202			14227
108​	2​			14227			21001
108 Count						2​

 

[Fluff]

How about

Sub LtCmdrData()
   Dim Rng As Range, Cl As Range
   
   For Each Rng In Range("E2:E" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlConstants).Areas
      If Rng.Count > 1 Then Rng.Offset(1).Resize(Rng.Count - 1).Value = Rng.Offset(, 3).Value
   Next Rng
End Sub

 

[mumps]

Problem solved.

 

[LtCmdrData]

How about

Sub LtCmdrData()
   Dim Rng As Range, Cl As Range
  
   For Each Rng In Range("E2:E" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlConstants).Areas
      If Rng.Count > 1 Then Rng.Offset(1).Resize(Rng.Count - 1).Value = Rng.Offset(, 3).Value
   Next Rng
End Sub

Thank you Fluff! I knew there had to be a solution and once again you came thru. I still have so much to learn about VBA.

 

[Fluff]

Glad we could help & thanks for the feedback.