CODEWITHSUNDEEP
vbaexcelcopy-paste
Philip Connell
Philip Connell

Reputation: 651

Copy and Paste Column to another column

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.
enter image description here

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

Upvotes: 0

Views: 11033

Answers (2)

5202456
5202456

Reputation: 962

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

Upvotes: 1

user6432984
user6432984

Reputation:

There is no need to use Delete or Insert. Range().Cut Destination:=Range() will move the cells into position for you.

Sub Sample()
    Dim aCell As Range

    With ThisWorkbook.Sheets("Sheet1")
        Set aCell = .Rows(1).Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _
                                          MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            aCell.EntireColumn.Cut Destination:=.Columns(5)
        Else
            MsgBox "Country Not Found"
        End If
    End With
End Sub

Upvotes: 1

Related Questions