Moving Data with vba - excel

Question

I received data in column F,G,H, and I. I need to get that all into column E and take out the duplicates and the blank cells. The code i have so far works but it puts them all in the same row and doesn't keep them on their appropriate lines. I need them to stay on the same line they are currently in but to just transcribe over into the other column. This is what I have so far:
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long, lastCol As Long, i As Long
Dim Rng As Range, aCell As Range, delRange As Range '<~~ Added This
Dim MyCol As New Collection
~~> Change this to the relevant sheet name
Set ws = Sheets("Sheet1")
With ws
'~~> Get all the blank cells
Set delRange = .Cells.SpecialCells(xlCellTypeBlanks) '<~~ Added This
'~~> Delete the blank cells
If Not delRange Is Nothing Then delRange.Delete '<~~ Added This
LastRow = .Cells.Find(What:="*", After:=.Range("A1"), _
Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
lastCol = .Cells.Find(What:="*", After:=.Range("A1"), _
Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, MatchCase:=False).Column
Set Rng = .Range("A1:" & Split(.Cells(, lastCol).Address, "$")(1) & LastRow)
'Debug.Print Rng.Address
For Each aCell In Rng
If Not Len(Trim(aCell.Value)) = 0 Then
On Error Resume Next
MyCol.Add aCell.Value, """" & aCell.Value & """"
On Error GoTo 0
End If
Next
.Cells.ClearContents
For i = 1 To MyCol.Count
.Range("A" & i).Value = MyCol.Item(i)
Next i
'~~> OPTIONAL (In Case you want to sort the data)
.Columns(1).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End Sub

Answer 1

Try this.
Sub CopyThingy()
Dim wb As Workbook
Dim ws As Worksheet
Dim lCount As Long
Dim lCountMax As Long
Dim lECol As Long
Dim lsourceCol As Long
lECol = 5 '* E column
Set wb = ThisWorkbook
Set ws = wb.Sheets(1) '*Your Sheet
lCountMax = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
lsourceCol = 6
lCount = lCountMax
Do While lCount > 1
If ws.Cells(lCount, lsourceCol) <> "" Then
ws.Cells(lCount, lECol).Value = ws.Cells(lCount, lsourceCol).Value
End If
lCount = lCount - 1
Loop
lCountMax = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
lsourceCol = 7
lCount = lCountMax
Do While lCount > 1
If ws.Cells(lCount, lsourceCol) <> "" Then
ws.Cells(lCount, lECol).Value = ws.Cells(lCount, lsourceCol).Value
End If
lCount = lCount - 1
Loop
lCountMax = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
lsourceCol = 8
lCount = lCountMax
Do While lCount > 1
If ws.Cells(lCount, lsourceCol) <> "" Then
ws.Cells(lCount, lECol).Value = ws.Cells(lCount, lsourceCol).Value
End If
lCount = lCount - 1
Loop
End Sub