excel - VBA: any idea how to remember originally selected cell to copy selection to it after the code

Question

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

Answer 1

It's really hard to tell what you intend but below is my best interpretation. Please try it.

Option Explicit

Sub Super_PasteInto1Col()
    ' 153
    ' Keyboard Shortcut: Ctrl+m

    ' TgtClm is the column where the results are deposited
    Const TgtClm        As Long = 18        ' change to suit
    
    Dim SelRng          As Range            ' range selected by the user
    Dim Clm             As Long             ' first column of SelRng
    Dim C               As Long             ' loop counter: Columns
    Dim Rt              As Long             ' target row
    
    Set SelRng = Selection
    Clm = SelRng.Column
    
    Application.ScreenUpdating = False
    With Columns(Clm)
        .Copy
        .PasteSpecial Paste:=xlPasteValues
    End With

    For C = 0 To (SelRng.Columns.Count - 1)
        ' start the range in row 2 (leave headers untouched)
        With Range(Cells(2, Clm + C), Cells(Rows.Count, Clm + C).End(xlUp))
            ' this range will start in row 1 if the column is otherwise blank
            If .Row > 1 Then
                .RemoveDuplicates Columns:=1, Header:=xlNo
                .SortSpecial (xlPinYin)
                
                If WorksheetFunction.CountA(Range(.Address)) Then
                    .Cut Cells(Rows.Count, TgtClm).End(xlUp).Offset(1)
                End If
            End If
            Columns(Clm + C).ClearContents
        End With
    Next C

    With Application
        .CutCopyMode = False
        .ScreenUpdating = False
    End With
End Sub

In my test I had captions for the columns in row 1. I selected a number of these headers. The first one is of special significance because formulas in that column will be replaced by the values they generate. After that each column of the selection is sorted, after removing duplicates, and the remainder, if any, pasted to column 18 (change at the top of the code). The the column is cleared.

I couldn't figure out why you wanted to return to the original selection. However, the Selection object is recorded at the very beginning and never changed. So it's available for whatever you have in mind with it.