基于列标题的VBA复制和粘贴列 [英] VBA Copy and Paste Column based of Column Heading

问题描述

希望您能提供帮助。我要达到的目的是：我希望VBA在找到该标题后，在列标题中进行搜索，以查找包含文本 CountryCode的标题。我希望它剪切并将其粘贴进入第六列。我的代码尝试在下面，但是无法正常工作，我附上了屏幕快照，以更好地理解。

I hope you can help. What I am trying to achieve is this: I want the VBA to search through column headings to find a heading that contains the text "CountryCode" once it finds this I want it to cut this column and paste it into the sixth column. My attempt at code is below but it not working correctly I have attached screen shots for better understanding.

我知道目的地：= Worksheets（ Sheet1）。Range（ E5）我错了无法看到将其粘贴到新创建的F列中

I know Destination:=Worksheets("Sheet1").Range("E5")is wrong I just cant seen to get it to paste into the newly created F Column

屏幕截图：国家/地区代码位于WI列中，只是无法将其粘贴到新的F列中。任何帮助将不胜感激。

Screen Shot: Country Code was in Column W I just cant get it to paste into the new F column. Any help would be greatly appreciated.

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

推荐答案

此代码是否可满足您的需求？

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

这篇关于基于列标题的VBA复制和粘贴列的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！