在excel 2007 vba中，1004工作表类错误粘贴方法失败

以下代码在Excel 2016中运行良好，但在Excel 2007中运行时也一样

工作表类的1004粘贴方法失败

遇到错误。

Sub productPicture() Sheet1.Select lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lastrow If Cells(i, 1) = ThisWorkbook.Sheets(2).Range("C4").Value Then ThisWorkbook.Sheets(1).Cells(i, 2).Copy End If Exit For Next i Sheet2.Select ThisWorkbook.Sheets(2).Range("D9:G17").Clear ThisWorkbook.Sheets(2).Range("D9:G17").Select ThisWorkbook.Sheets(2).Paste End Sub 

Answer 1

而不是使用For循环来扫描列“A”中的所有值，您可以使用Match函数，它将为您节省宝贵的时间，一旦您学习如何使用它，它是VBA中最好的工具之一。

另外，更好的动作顺序是首先Clear你打算稍后粘贴的Range ，然后你可以使用Copy >> Paste单行语法，例如：

 .Range("B" & MatchRow).Copy Destination:=ThisWorkbook.Sheets(2).Range("D9") 

注意 ：我通常使用With语句，它使得代码看起来更好更短，同样所有的Range和Cells对象都被Worksheet对象完全限定。 （而不是使用Select ，这是不推荐的）。

码

 Option Explicit Sub productPicture() Dim LastRow As Long Dim MatchRow As Long ' first clear the Range where you want to paste ThisWorkbook.Sheets(2).Range("D9:G17").Clear With ThisWorkbook.Sheets(1) LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row ' === instead of Loop use Match function == ' make sure Match was able to find a amatch in the range If Not IsError(Application.Match(ThisWorkbook.Sheets(2).Range("C4").Value, .Range("A2:A" & LastRow), 0)) Then MatchRow = Application.Match(ThisWorkbook.Sheets(2).Range("C4").Value, .Range("A2:A" & LastRow), 0) ' Copy >> Paste in a 1-line command .Range("B" & MatchRow).Copy Destination:=ThisWorkbook.Sheets(2).Range("D9") End If End With End Sub 

Answer 2

这是您的代码遵循最佳实践的样子。 有关详情，请参阅代码中的注释。

 Option Explicit 'Using this as very first line will ensure all variables are declared. Public Sub ProductPicture() Dim iRow As Long 'row iteration Dim lRow As Long 'last used row Dim wsSrc As Worksheet 'source worksheet Dim wsDest As Worksheet 'destination worksheet Set wsSrc = Sheet1 'set source worksheet Set wsDest = Sheet2 'set destination worksheet lRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row 'find last used row For iRow = 2 To lRow If wsSrc.Cells(iRow, 1) = wsDest.Range("C4").Value Then With wsDest.Range("D9:G17") .Clear 'If you clear, then always clear BEFORE copy 'because `clear` kills the for copy selected range 'like `Application.CutCopyMode = False` wsSrc.Cells(iRow, 2).Copy 'copy from source .PasteSpecial xlPasteAll 'paste into destination range: see `With …` End With 'Exit For 'probably this is the position you might want the Exit For 'instead of below End If Exit For 'exit for at this position doesn't make sense at all, 'because it will ALWAYS exit here without iterating iRow 'you don't need a loop then if this was your aim. Next iRow End Sub 

注意： 你也可以看看[Shai Rado的回答] [1]，这是一个不同的，也许是更好的方法。

Answer 3

 Sub productPicture() Sheet1.Select Lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To Lastrow If Cells(i, 1) = ThisWorkbook.Sheets(2).Range("C4").Value Then Sheet2.Select ThisWorkbook.Sheets(2).Range("D9:G17").Clear ThisWorkbook.Sheets(2).Range("D9:G17").Select ThisWorkbook.Sheets(1).Cells(i, 2).Copy Selection.PasteSpecial xlPasteAll End If Exit For Next i End Sub