将条件数据复制到特定单元的VBA宏 [英] VBA macro for copying conditional data to specific cells

问题描述

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

  Sub CopyValues（）
 
'声明变量
'声明表变量
 Dim Sourcews As Worksheet 
 Dim Pastews As Worksheet 
 
'声明计数器变量
 Dim i As Integer 
 Dim n As Integer 
 Dim lastrow As Long 
 
 Set Sourcews = ThisWorkbook.Sheets（Source） 
设置Pastews = ThisWorkbook.Sheets（Paste）
 
 lastrow = Cells.Find（*，SearchOrder = = xlByRows，SearchDirection：= xlPrevious）.Row 
 
 For i = 3 To lastrow 
 
如果Sourcews.Range（i，AA）。值=需要的值然后
 
 Pastews.Cells（C粘贴
 Pastews.Cells（D：18）。粘贴
 Pastews.Cells（E：18）。粘贴
 Pastews.Cells（F：18 ）.Paste 
 Pastews.Cells（G：18）。粘贴
 Pastews.Cells（H：18）。粘贴
 
 
 
结束如果
 
下一个
  

解决方案

我假设你要粘贴到第18行，然后粘贴到19等等，而不是18反复！

  Sub CopyValues（）
 
'声明变量
'声明表变量
 Dim Sourcews As Worksheet 
 Dim Pastews As Worksheet 
 
'声明计数器变量
 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 
 
对于i = 3 To lastrow 
如果Sourcews.Cells（i，AA）。值=需要的值然后
 Sourcews.Cells（i，AA）。复制Pastews.Cells（n ，C）。调整大小（，6）
n = n + 1 
结束如果
下一个
 
 End Sub 
  

I'm new to programming in VBA and I'm looking To take data from different worksheets that matches a condition. Then copy and paste from one specific cell to another specific cell 7 times. The code I have doesn't work and I'm looking to improve it. As I run the code I get flagged for Run time error '1004' Method 'Range of object '_Worksheet' failed at the beginning of the IF statement.

 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

解决方案

Try this. I'm assuming you want to paste into row 18 and then 19 etc, and not 18 repeatedly!

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

这篇关于将条件数据复制到特定单元的VBA宏的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！