Copy and Paste Column to another column

Question

I want to search through column headings to find a heading that contains the text "CountryCode".
I want to cut this column and paste it into the sixth column.

I know Destination:=Worksheets("Sheet1").Range("E5")is wrong.

Screen Shot: Country Code was in Column W. I want to paste into the new F column.

Sub Sample()
    Dim ws As Worksheet
    Dim aCell As Range, Rng As Range
    Dim col As Long, lRow As Long
    Dim colName As String

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        Set aCell = .Range("A1:X50").Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _
                    MatchCase:=False, SearchFormat:=False)
    '~~> If Found
    If Not aCell Is Nothing Then
    Worksheets("Sheet1").Range("W1:W3").Cut _
            Destination:=Worksheets("Sheet1").Range("E5")
            Columns([23]).EntireColumn.Delete
            Columns("F:F").Insert Shift:=xlToRight, _
    CopyOrigin:=xlFormatFromLeftOrAbove
    '~~> If not found
    Else
            MsgBox "Country Not Found"
        End If
    End With
End Sub

Answer 1

Does this code do what you are looking for?

Sub Sample()
    Dim ws As Worksheet
    Dim aCell As Range, Rng As Range
    Dim col As Long, lRow As Long
    Dim colName As String

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        Set aCell = .Range("A1:X50").Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _
                    MatchCase:=False, SearchFormat:=False)
    '~~> If Found
    If Not aCell Is Nothing Then

    '~~> Cut the entire column
    aCell.EntireColumn.Cut

    '~~> Insert the column here
    Columns("F:F").Insert Shift:=xlToRight

    Else
    MsgBox "Country Not Found"

    End If
    End With
End Sub