VBA Копия и вставка Столбец на основе столбца Заголовок

Question

Надеюсь, вы сможете помочь. То, что я пытаюсь достичь, заключается в следующем: я хочу, чтобы VBA просматривал заголовки столбцов, чтобы найти заголовок, содержащий текст «CountryCode», как только он найдет это, я хочу, чтобы он вырезал этот столбец и вставил его в шестой столбец. Моя попытка кода ниже, но она не работает правильно. Я добавил скриншоты для лучшего понимания.

Я знаю Destination:=Worksheets("Sheet1").Range("E5") неправильно, я просто не могу видеть, чтобы получить его, чтобы вставить в недавно созданный F Колонка

Screen Shot: Код страны был в колонке W Я просто не могу получить его, чтобы вставить в новый столбец F. Любая помощь будет принята с благодарностью.

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

Выполняет ли этот код то, что вы ищете?

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 

Answer 2

Там нет необходимости использовать Удалить или Вставить. Range().Cut Destination:=Range() переместит ячейки в нужное положение.

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