vba Excel 宏在粘贴时出错

Excel Macro giving error when pasting

提问by fightstarr20

I am trying to create an excel macro which is probably going to end up being quite large, to make things easier I am tackling it a bit at a time. So far I have....

我正在尝试创建一个 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

I want it to do the following....

我希望它执行以下操作....

• Search the spreadsheet for the header name 'product_name'
• Insert a blank column to the left of the 'product_name'column
• Copy the contents of the 'product_name'column
• Paste them into the newly created blank column
• Change the header name in this new column to 'product_name_2'

• 在电子表格中搜索标题名称“product_name”
• 在“product_name”列的左侧插入一个空白列
• 复制“product_name”列的内容
• 将它们粘贴到新创建的空白列中
• 将此新列中的标题名称更改为“product_name_2”

Currently it works fine up until the pasting into this newly created column, then i get a

目前它工作正常，直到粘贴到这个新创建的列中，然后我得到一个

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

Can anyone suggest where i am going wrong?

谁能建议我哪里出错了？

回答by Tony Dallimore

Your error is:

你的错误是：

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

This selects from the top of the column down to just above the first blank cell. The insert shifts this portion of the column right leaving the rest where it is. When you select again you are likely to get a larger range because you have mixed two columns. The copy fails because you are then trying to copy values over the top of values.

这将从列的顶部选择到第一个空白单元格的正上方。插入将列的这一部分向右移动，将其余部分留在原处。当您再次选择时，您可能会获得更大的范围，因为您混合了两列。复制失败，因为您随后尝试复制值顶部的值。

If that does not make sense, step through your macro with F8 and see what is happening at each step.

如果这没有意义，请使用 F8 单步执行宏并查看每一步发生的情况。

When you understand why your current macro does not work, try this:

当您了解为什么当前的宏不起作用时，请尝试以下操作：

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

Note:

笔记：

1. I did not select anything.
2. I have left the code operating on the active sheet but it is better to use With Sheets("XXX")... End With.

1. 我没有选择任何东西。
2. 我已将代码留在活动表上运行，但最好使用With Sheets("XXX")... End With。

Answer to second question

回答第二个问题

The macro recorder is not good at showing how to address individual cells systematically.

宏记录器不擅长显示如何系统地寻址单个单元格。

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

The above uses Withwhich I recommend. Notice the dot in front of Cells.

以上With是我推荐的用途。注意 Cells 前面的点。

The one below operates on the active sheet.

下面的一个在活动工作表上操作。

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

RowNum must be a number. ColNum can be a number (say 5) or a letter (say "E").

RowNum 必须是一个数字。ColNum 可以是数字（比如 5）或字母（比如“E”）。

In your case RowNum is 1 and ColNum is ColToBeCopied and ColToBeCopied + 1.

在您的情况下，RowNum 为 1，ColNum 为 ColToBeCopied 和 ColToBeCopied + 1。

P.S.

聚苯乙烯

I forgot to mention that to find the botton row of a column use:

我忘了提到要找到列使用的底部行：

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

That is move up from the bottom not down from the top.

即从底部向上移动，而不是从顶部向下移动。

P.S. 2

附注 2

To specify a range using Cells:

要使用单元格指定范围：

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

The dots must match: all three or none.

点必须匹配：全部三个或没有。

回答by Boaz

I'm not sure where you are trying to copy to, but when you want to paste you need to make a selection and then
ActiveSheet.Paste
For example:

我不确定您要复制到哪里，但是当您要粘贴时，您需要先进行选择，然后使用
ActiveSheet.Paste
例如：

/your code/
Selection.Copy

/您的代码/
Selection.Copy

Range("O:O").Select
ActiveSheet.Paste

范围（“O：O”）。选择
ActiveSheet.Paste

回答by cako

I would avoid copying / pasting altogether, if you only want to transfer values.

如果您只想传输值，我会避免完全复制/粘贴。

For example, instead of:

例如，而不是：

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

I would use:

我会用：

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

If we were to substitute that into your code, and include some of the comments made by Tony:

如果我们将其替换到您的代码中，并包含 Tony 的一些评论：

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