基于列标题的VBA复制和粘贴列

时间:2016-10-06 10:50:53

标签: excel vba excel-vba copy-paste

我希望你能提供帮助。我想要实现的是:我希望VBA搜索列标题以找到包含文本“CountryCode”的标题,一旦找到它我想要剪切此列并粘贴它进入第六栏。我对代码的尝试在下面,但是它没有正常工作我已经附加了屏幕截图以便更好地理解。

我知道Destination:=Worksheets("Sheet1").Range("E5")是错的我只是看不到要粘贴到新创建的F列

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

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

2 个答案:

答案 0 :(得分:1)

无需使用删除或插入。 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

答案 1 :(得分: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