Макрос Excel дает ошибку при вставке

Question

Я пытаюсь создать макрос Excel, который, вероятно, в конечном итоге будет достаточно большим, чтобы упростить задачу, я немного разбираюсь с ним за раз.Пока что у меня есть ....

Sub Macro4()
'
' Test Macro
'
  'Selects the product_name column by header name
  Dim rngAddress As Range
  Set rngAddress = Range("A1:Z1").Find("product_name")
  If rngAddress Is Nothing Then
  MsgBox "The product_name column was not found."
  Exit Sub
  End If
  Range(rngAddress, rngAddress.End(xlDown)).Select

  'Inserts new column to the left of the product_name column
   Selection.Insert Shift:=xlToRight

  'Re-selects the product_name column
   Range(rngAddress, rngAddress.End(xlDown)).Select

  'Copys the contents of the product_name column
   Selection.Copy
   Selection.Paste

End Sub

Я хочу, чтобы он сделал следующее ....

• Поиск в таблице по имени заголовка 'product_name'
• Вставьте пустой столбец слева от 'product_name' столбца
• Скопируйте содержимое 'product_name' столбца
• Вставьте их во вновь созданный пустой столбец
• Измените имя заголовка в этом новом столбце на 'product_name_2'

В настоящее время работает нормальновплоть до вставки в эту недавно созданную колонку, тогда я получаю

'Run-time error '438'; - Object doesn't support this property or method'

Кто-нибудь может подсказать, где я ошибаюсь?

Answer 1

Ваша ошибка:

Range(rngAddress, rngAddress.End(xlDown)).Select

Выбирается от верхней части столбца до чуть выше первой пустой ячейки.Вставка сдвигает эту часть колонки вправо, оставляя остальную часть там, где она есть.При повторном выборе вы, вероятно, получите больший диапазон, потому что вы смешали два столбца.Копирование завершается неудачно, потому что вы затем пытаетесь скопировать значения поверх значений.

Если это не имеет смысла, прокрутите макрос с помощью F8 и посмотрите, что происходит на каждом шаге.

Когда вы поймете, почему ваш текущий макрос не работает, попробуйте следующее:

Sub Macro5()

  Dim rngAddress As Range
  Dim ColToBeCopied As Integer

  Set rngAddress = Range("A1:Z1").Find("'product_name")
  If rngAddress Is Nothing Then
    MsgBox "The product_name column was not found."
    Exit Sub
  End If

  ColToBeCopied = rngAddress.Column
  Columns(ColToBeCopied).EntireColumn.Insert
  Columns(ColToBeCopied + 1).Copy Destination:=Columns(ColToBeCopied)

End Sub

Примечание:

1. Я ничего не выбрал.
2. Я оставилкод, работающий на активном листе, но лучше использовать With Sheets("XXX") ... End With.

Ответ на второй вопрос

Макросрекордер не умеет показывать, как систематически обращаться к отдельным ячейкам.

With Sheets("xxxx")
  .Cells(RowNum,ColNum).Value = "product_name 1"
End With

Выше указано With, которое я рекомендую.Обратите внимание на точку перед ячейками.

Нижеследующая точка действует на активный лист.

Cells(RowNum,ColNum).Value = "product_name 1"

RowNum должен быть числом.ColNum может быть числом (скажем, 5) или буквой (скажем, «E»).

В вашем случае RowNum равен 1, а ColNum равен ColToBeCopied и ColToBeCopied + 1.

PS

Я забыл упомянуть, что для поиска нижнего ряда столбцов используйте:

RowLast = Range(Rows.Count, ColNum).End(xlUp).Row

Это движение вверх снизу, а не сверху вниз.

PS 2

Чтобы указать диапазон с помощью ячеек:

.Range(.Cells(Top,Left),.Cells(Bottom,Right))

Точки должны совпадать: все три или ни одного.

Answer 2

Я бы вообще не копировал / вставлял, если вы хотите передавать только значения.

Например, вместо:

Range("B1:B100").Copy Destination:=Range("A1")

Я бы использовал:

Range("A1:A100").Value = Range("B1:B100").Value

Если бы мы подставили это в ваш код и включили некоторые комментарии, сделанные Тони:

Sub Macro4()

    Dim colFound  As Integer
    Dim rowLast As Long

    Const rowSearch As Integer = 1

    'Find the product_name column
    colFound = Rows(rowSearch).Find("product_name").Column

    If colFound = 0 Then
        MsgBox "The product_name column was not found."
        Exit Sub
    End If

    'Find the last non-empty row
    rowLast = Cells(Rows.Count, colFound).End(xlUp).Row

    'Inserts new column to the left of the product_name column
    Columns(colFound).EntireColumn.Insert

    'Transfer the contents of the product_name column to the newly inserted one
    Range(Cells(rowSearch, colFound), Cells(rowLast, colFound)).Value = _
     Range(Cells(rowSearch, colFound + 1), Cells(rowLast, colFound + 1)).Value

    'Rename the new column
    Cells(rowSearch, colFound).Value = Cells(rowSearch, colFound).Value & "_2"

End Sub

Answer 3

Я не уверен, куда вы пытаетесь скопировать, но когда вы хотите вставить, вам нужно сделать выбор, а затем
ActiveSheet.Paste
Например:

/ ваш код / ​​
Выбор. Копия

Диапазон. ( "O: O") Select
ActiveSheet.Paste