Copy Values from Column to Row

[J_Raab]

Not even sure excel is able to do what I want this way but I'm trying to take data that's in Column D on sheet "RemoveDup" and copy it to Row 2 on sheet "Final" using a VBA. If the VBA finds a blank cell in the RemoveDup Column the VBA ends.

So the below code "works" in the sense that it moves the first value in Range Sect (named because it houses Section names) and copies it to the first cell in Range SectFin (named because it's the final location of Section name) but it deletes the value from Sect rather than Offsetting the Range to the next row down and running the Copy code again. The Cell.Value="Nope" will eventually just become "End" but I put the "Nope" in to see if it actually was looping through all the cells for SectFin, which it does. So I end up with Final!B2 containing the right value, the rest of the second row showing "Nope" and the value from RemoveDup!D2 being deleted, even though I never tell it to delete. Can anybody help tell me what I'm missing?


Sub DataRun()


Dim Sect As Range
Set Sect = Range("RemoveDup!D2") 'Original cell value - in column


Dim SectFin As Range
Set SectFin = Range("Final!B2:ZZ2") 'New row


For Each cell In SectFin
If Sect.Value = "" Then
cell.Value = "Nope"
Else
Sect.Copy Destination:=SectFin
Sect = cell.Offset(1, 0)
End If
Next cell




End Sub

 

[Norie]

If you want to move values from column D on sheet 'RemoveDup' why aren't you looping down that range?

 

[bellman101]

Hi J Raab,

For the first loop, Sect is Cell D2 of sheet "RemoveDup". At the end of the first loop however, you are setting Sect to the cell below 'cell', and 'cell' is on sheet "Final". So from the 2nd loop onwards, Sect and cell are the same cell.

Try changing Sect = cell.offset(1,0) to Sect = Sect.offset(1,0)

Cheers
JB

 

[J_Raab]

Really appreciate the assist you two but I figured it out. I was over-thinking the crap out of it and making it 100 times more difficult on myself. The data changes but the total number of sections won't exceed 50, so I just wrote the code below and it works fine. I tried to get to fancy with it and it hit me over the holiday weekend how much simpler it could have been. Appreciate the help though. Hope the below code helps anyone with a similar problem (if your data set is larger or smaller just adjust the ranges to meet your needs)

Sub DataRun()


Dim Sect As Range
Set Sect = Range("RemoveDup!D2:D50") 'Original cell value - in column


Dim SectFin As Range
Set SectFin = Range("Final!B2:AY2") 'New row


Sect.Copy
SectFin.PasteSpecial Transpose:=True


End Sub