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

Question

我正在尝试复制表的前 17 列，对于满足某些条件的行，这以前在复制整行时有效，但代码不再有效，放弃运行时错误 1004，说"方法'对象范围'工作表失败">

代码为：

    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( 返回一个范围，因此可以简化粘贴线：

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

Answer 2

您可以使用自动筛选功能，而不是迭代。然后将过滤范围复制到所需的工作表中。
所以在你的例子中，它看起来像这样：

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