VBAmacros将条件数据复制到特定的单元格

我是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") 。 对于这样的问题，您也可以尝试录制一个macros，并从Excel告诉您学习代码。

Answer 3

If应该是这样的：

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

然后在Pastews.Cells ，它应该被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复制的.paste 。 我只是避免复制和粘贴方法（它们效率低下），并将单元格设置为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 

或者你可以将值设置为一个variables，以获得更清晰的代码，如下所示：

 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需要一个嵌套循环移动列

关于这个post里没有的细节，与海报有很长的一段对话。