Hi I need some help for this. I want to select columns of cells and extract only unique values and narrow down all of that results into 1 column. The code is working fine except the part where I want it to be pasted to the original cell I selected. I have tried setting cell = activecell. But I keep getting errors when I return to it after all the code at the end saying "Runtime error 1004 cut method of range class failed". Thanks I really appreciate any help for this.
Sub Super_PasteInto1Col()
'
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+m
'
Dim i As Integer
Dim icolumns As Long
Dim columns As Long
Dim rselection As Range
Dim EntireColumn As Range
Dim cell As Range
Set cell = ActiveCell
Application.Goto ActiveCell.EntireColumn.End(xlUp)
Selection.PasteSpecial Paste:=xlPasteValues
Set rselection = Selection
For i = 1 To rselection.columns.Count
Selection.columns(i).RemoveDuplicates columns:=1, Header:=xlGuess
Selection.columns(i).SortSpecial (xlPinYin)
Next i
icolumns = rselection.columns.Count - 1
For i = 1 To icolumns
Application.Goto rselection.columns(i + 1).End(xlUp)
Set EntireColumn = Selection.EntireColumn
If Application.WorksheetFunction.CountA(EntireColumn) = 1 Then
If Application.WorksheetFunction.CountA(rselection.columns(1)) = 1 Then
Selection.Cut rselection.columns(1).End(xlUp).Offset(1, 0)
Else
Selection.Cut rselection.columns(1).End(xlDown).Offset(1, 0)
End If
ElseIf Application.WorksheetFunction.CountA(EntireColumn) = 0 Then
Application.Goto Selection
Else
Application.Goto Range(Selection, Selection.End(xlDown))
If Application.WorksheetFunction.CountA(rselection.columns(1)) = 1 Then
Selection.Cut rselection.columns(1).End(xlUp).Offset(1, 0)
Else
Selection.Cut rselection.columns(1).End(xlDown).Offset(1, 0)
End If
End If
Next i
Application.Goto rselection.columns(1).EntireColumn
Selection.RemoveDuplicates columns:=1, Header:=xlNo
Selection.SortSpecial (xlPinYin)
Application.Goto Selection.End(xlUp)
Application.Goto Range(Selection, Selection.End(xlDown))
Selection.Cut cell
Exit Sub
End Sub