Скопируйте и вставьте столбец в другой столбец

#vba #excel #copy-paste

#vba #excel #копировать-вставить

Вопрос:

Я хочу выполнить поиск по заголовкам столбцов, чтобы найти заголовок, содержащий текст «Код страны».
Я хочу вырезать этот столбец и вставить его в шестой столбец.

Я знаю Destination:=Worksheets("Sheet1").Range("E5") , что это неправильно.

Снимок экрана: код страны был в столбце 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

1. ваш «проблемный» код уже находится внутри With ws ( ws уже определен и установлен в ThisWorkbook.Sheets("Sheet1") ). итак, внутри цикла вам нужно изменить Worksheets("Sheet1").Range("W1:W3") на .Range("W1:W3") , а также Destination:=Worksheets("Sheet1").Range("E5") на Destination:=.Range("E5") , если они являются целью и местом назначения вашего копирования> Вставить

Ответ №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

Ответ №2:

Нет необходимости использовать Delete или Insert. 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