Question

我是VBA编程的新手，我正在寻找从不同的工作表中获取符合条件的数据。然后从一个特定细胞复制并粘贴到另一个特定细胞7次。我的代码不起作用，我正在寻求改进它。当我运行代码时，我被标记为运行时错误'1004'方法'对象范围'_Worksheet'在IF语句的开头失败。

 Sub CopyValues()

 'Declare variables
 'Declare sheet variables
 Dim Sourcews As Worksheet
 Dim Pastews As Worksheet

 'Declare counter variables
 Dim i As Integer
 Dim n As Integer
 Dim lastrow As Long

 Set Sourcews = ThisWorkbook.Sheets("Source")
 Set Pastews = ThisWorkbook.Sheets("Paste")

  lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 For i = 3 To lastrow

 If Sourcews.Range(i, "AA").Value = "Needed Value" Then

    Pastews.Cells("C:18").Paste
    Pastews.Cells("D:18").Paste
    Pastews.Cells("E:18").Paste
    Pastews.Cells("F:18").Paste
    Pastews.Cells("G:18").Paste
    Pastews.Cells("H:18").Paste



End If

Next

Answer 1

试试这个。我假设您想要粘贴到第18行然后是19等，而不是18次！

Sub CopyValues()

'Declare variables
'Declare sheet variables
Dim Sourcews As Worksheet
Dim Pastews As Worksheet

'Declare counter variables
Dim i As Long
Dim n As Long
Dim lastrow As Long

Set Sourcews = ThisWorkbook.Sheets("Source")
Set Pastews = ThisWorkbook.Sheets("Paste")

lastrow = Sourcews.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
n = 18

For i = 3 To lastrow
    If Sourcews.Cells(i, "AA").Value = "Needed Value" Then
        Sourcews.Cells(i, "AA").Copy Pastews.Cells(n, "C").Resize(, 6)
        n = n + 1
    End If
Next

End Sub

Answer 2

而不是使用.Cells("C:18")使用.Range("C18")。对于这样的问题，您还可以尝试从Excel告诉您的方式录制宏和学习代码。

Answer 3

If应该是这样的：

If Sourcews.Range("AA"&i).Value = "Needed Value" Then

然后在Pastews.Cells中，应该像这样引用工作表：

pastews.Range("A18").Copy Destination:=pastews.Range("H18")

或

pastews.Cells(18,1).Copy Destination:=pastews.Cells(18,8)

以下是关于VBA范围的 MSDN 文章 - 值得一读 - https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-object-excel

Answer 4

除了其他人讨论的一些语法错误之外，在尝试使用.paste方法之前，尚未指定bieng复制的内容。我只是避免复制和粘贴方法（它们效率低下）并将单元格设置为if语句中的范围值，如下所示：

Sub CopyValues()

 'Declare variables
 'Declare sheet variables
 Dim Sourcews As Worksheet
 Dim Pastews As Worksheet

 'Declare counter variables
 Dim i As Integer
 Dim n As Integer
 Dim lastrow As Long

 Set Sourcews = ThisWorkbook.Sheets("sheet1")
 Set Pastews = ThisWorkbook.Sheets("sheet2")

  lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 For i = 3 To lastrow

If Sourcews.Range("AA" & i).Value = "Needed Value" Then

    Pastews.Range("C18") = Sourcews.Range("AA" & i).Value
    Pastews.Range("D18") = Sourcews.Range("AA" & i).Value
    Pastews.Range("E18") = Sourcews.Range("AA" & i).Value
    Pastews.Range("F18") = Sourcews.Range("AA" & i).Value
    Pastews.Range("G18") = Sourcews.Range("AA" & i).Value



End If

Next

End Sub

或者您可以将值设置为变量以获得更清晰的代码，如下所示：

Sub CopyValues()

 'Declare variables
 'Declare sheet variables
 Dim Sourcews As Worksheet
 Dim Pastews As Worksheet

 'Declare counter variables
 Dim i As Integer
 Dim n As Integer
 Dim lastrow As Long
 Dim x As String

 Set Sourcews = ThisWorkbook.Sheets("sheet1")
 Set Pastews = ThisWorkbook.Sheets("sheet2")

  lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 For i = 3 To lastrow

If Sourcews.Range("AA" & i).Value = "Needed Value" Then

    x = Sourcews.Range("AA" & i).Value
    Pastews.Range("C18") = x
    Pastews.Range("D18") = x
    Pastews.Range("E18") = x
    Pastews.Range("F18") = x
    Pastews.Range("G18") = x



End If

Next

End Sub

或者，为了使代码更简洁，您可以将接收复制值的范围组合为Pastews.Range("C18:G18") = x，如下所示：

Sub CopyValues()

 'Declare variables
 'Declare sheet variables
 Dim Sourcews As Worksheet
 Dim Pastews As Worksheet

 'Declare counter variables
 Dim i As Integer
 Dim n As Integer
 Dim lastrow As Long
 Dim x As String

 Set Sourcews = ThisWorkbook.Sheets("sheet1")
 Set Pastews = ThisWorkbook.Sheets("sheet2")

  lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 For i = 3 To lastrow

If Sourcews.Range("AA" & i).Value = "Needed Value" Then

    x = Sourcews.Range("AA" & i).Value
    Pastews.Range("C18:G18") = x

End If

Next

End Sub

我知道我发布了很多内容，但我希望向您展示如何使您的内容更加简洁高效。我希望它有所帮助。

Answer 5

我正在处理重复的问题并提供了这个答案：

尝试：

Sub CopyValues()

'Declare counter variables
Dim i As Integer, j as Integer, lastrow As Long
'Declare variables
Dim Sourcedataws As Worksheet, WStotransfer As Worksheet
'Declare sheet variables
Set Sourcedataws = ThisWorkbook.Sheets("Source Data")
Set WStotransferws = ThisWorkbook.Sheets("WStotransfer")

lastrow = Sourcedataws.Cells(Sourcedataws.Rows.Count, "A").End(xlUp).Row

WStotransferws.Range("C18:I18").ClearContents

For i = 2 To lastrow
If WStotransferws.Range("I18").Value="" Then
    If Sourcedataws.Range("AA" & i).Value = "Condition" Then
        Sourcedataws.Range("A"&i).Copy 
        j=WStotransferws.Cells(18, WStotransferws.Columns.Count).End(xlToLeft).Column
        WStotransferws.Cells(18,j+1).PasteSpecial xlPasteValues
        End If
    Else
    End If
Next i

End Sub

发现其他帖子：VBA Need a Nested Loop to shift columns

与海报进行了长时间的谈话，讨论了帖子中没有的细节。

用于将条件数据复制到特定单元格的VBA宏

5 个答案: