尝试复制并粘贴列的一部分，使用If语句，运行时错误1004

Question

我正在尝试复制表的前17列，对于满足特定条件的行，这以前在复制整行时有效，但代码不再起作用，放弃了运行时错误1004，并说"Method 'Range of Object‘Worksheet failed“

代码是：

    Sub CopyRowsAcross()

 'Name Worksheets
  Dim e As Integer
  Dim wsd2 As Worksheet: Set wsd2 = ThisWorkbook.Sheets("DataSheet2")
  Dim wsBS As Worksheet: Set wsBS = ThisWorkbook.Sheets("Budget Summary")


'Set variables
For e = 3 To 1776
Dim LastRow As Long

LastRow = wsBS.UsedRange.Row - 1 + wsBS.UsedRange.Rows.Count

'Set Criteria for copying lines across
If ((IsEmpty(wsd2.Cells(e, 1).Value) = False And IsEmpty(wsd2.Cells(e, 4).Value)) = True) Or (IsEmpty(wsd2.Cells(e, 1).Value) = False And IsEmpty(wsd2.Cells(e, 4).Value) = False) Or (IsEmpty(wsd2.Cells(e, 1).Value) = True And IsEmpty(wsd2.Cells(e + 1, 5).Value) = False And IsEmpty(wsd2.Cells(e, 4).Value) = False) Then

'Particulars of copying
wsd2.Range(Cells(e, 1), Cells(e, 17)).Copy
*wsBS.Range(Cells(LastRow + 1, 1)).PasteSpecial xlPasteValues*
End If


Next e

End Sub

带星号的行已作为问题突出显示。

我希望有人能告诉我为什么它不工作以及如何修复它？非常感谢

Answer 1

如果未指定，Cells将引用当前活动工作表的单元格，因此始终指定工作表或区域。另一方面，cells(r，c)返回一个范围，因此可以简化Paste-Line：

wsd2.Range(wsd2.Cells(e, 1), wsd2.Cells(e, 17)).Copy
wsBS.Cells(LastRow + 1, 1).PasteSpecial xlPasteValues

Answer 2

您可以使用AutoFilter功能而不是迭代。然后将过滤后的范围复制到所需的工作表中。

所以在你的例子中，它看起来像这样：

With wsd2
        .AutoFilterMode = False
        'Based on your example, you need 17 columns (hence Q)
        .Range("A1:Q1").AutoFilter
        'Set the criteria here - you can set multiple criterias if required
        .Range("A1:Q1").AutoFilter Field:=<enter column number>, Criteria1:="<enter criteria for column>"
        .Range("A1:Q1").Parent.AutoFilter.Range.Copy
End With

'Here I'm showing how to copy into a new sheet. 
Set WSNew = Worksheets.Add(After:=Sheets(ActiveSheet.Index))
WSNew.Name = "Budget Summary"
'If sheet exists you can directly start from here and replace WSNew with wsBS 
 With WSNew.Range("A1")
    ' Paste:=8 will copy the columnwidth in Excel 2000 and higher
    ' Remove this line if you use Excel 97
    .PasteSpecial Paste:=8
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    .Select
End With