用于将满足条件的行中的选定列复制到另一个工作表的 VBA 代码

VBA code to copy selected columns from rows that meet a condition to another sheet

提问by JohnM

I've just started out with VBA code for Excel so apologies if this appears basic. I want to do the following...

我刚刚开始使用 Excel 的 VBA 代码，所以如果这看起来很基本，我深表歉意。我想做以下...

Check Column J (J5 to J500) of a sheet called "Index" for the presence of value "Y". This is my condition. Then I want to only copy Columns C to I Onlyof any row that meets the condition to an existing Sheet and to Cells in a different position, i.e. If Index values C3 to I3 are copied I would like to paste them to A5 to G5 of the active sheet i'm in, say Sheet2.

检查名为“索引”的工作表的 J 列（J5 到 J500）是否存在值“Y”。这是我的条件。然后我只想将满足条件的任何行的列 C复制到 I Only到现有工作表和不同位置的单元格，即如果索引值 C3 到 I3 被复制，我想将它们粘贴到 A5 到 G5我所在的活动表，比如 Sheet2。

If there is a change to the index sheet I would like the copied data to automatically, If possible. How could it work if new data is added to Index?

如果索引表有变化，我希望自动复制数据，如果可能的话。如果将新数据添加到索引中，它会如何工作？

After a lot of searching here I found this. From this question I changed the code slightly to suit my requirements and this will copy entire rows that meet the condition to a sheet that I run the macro from, but I'm stumped for how to select certain columns only.

在这里搜索了很多之后，我找到了这个。从这个问题我稍微更改了代码以满足我的要求，这会将满足条件的整行复制到我从中运行宏的工作表中，但我对如何仅选择某些列感到困惑。

Sub CopyRowsAcross() 

Dim i As Integer 
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Index") 
Dim ws2 As Worksheet: Set ws2 = ActiveSheet 

For i = 2 To ws1.Range("B65536").End(xlUp).Row 
If ws1.Cells(i, 2) = "Y" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1) 
Next i 

End Sub 

Any Help is appreciated

任何帮助表示赞赏

John

约翰

EDIT: I have created a mock-up and its located at https://docs.google.com/file/d/0B0RttRif9NI0TGl0N1BZQWZfaFk/edit?usp=sharing

编辑：我创建了一个模型，它位于https://docs.google.com/file/d/0B0RttRif9NI0TGl0N1BZQWZfaFk/edit?usp=sharing

The A and B Columns are not required when copied - either is Column J - thats what I am using to check for the condition.

复制时不需要 A 和 B 列 - 要么是 J 列 - 这就是我用来检查条件的内容。

Thanks for all your help so far.

感谢您到目前为止的所有帮助。

采纳答案by Atl LED

Here is the more elegant solution, more similar to my original post. The only difference is that the Cells reference is qualified to the correct sheet.

这是更优雅的解决方案，更类似于我原来的帖子。唯一的区别是 Cells 引用被限定为正确的工作表。

Sub try3()
Dim i, x As Long
Dim Y as String
Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index")
Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get  you into trouble

 x = 5
 Y = "Y"
 For i = 2 To 500:
    If ws1.Cells(i, 10) = Y Then
       Range(ws2.Cells(x, 1), ws2.Cells(x, 7)).Value = Range(ws1.Cells(i, 3), ws1.Cells(i, 9)).Value
      x = x + 1
    End If
 Next i
End Sub

Sub try3()
Dim i, x As Long
Dim Y as String
Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index")
Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get  you into trouble

 x = 5
 Y = "Y"
 For i = 2 To 500:
    If ws1.Cells(i, 10) = Y Then
       Range(ws2.Cells(x, 1), ws2.Cells(x, 7)).Value = Range(ws1.Cells(i, 3), ws1.Cells(i, 9)).Value
      x = x + 1
    End If
 Next i
End Sub

回答by Atl LED

That's borrowing some old code. In this you are checking for the last row used, if you know that you only want to go to 500, you can just use the integer:

那是借用一些旧代码。在这里，您正在检查使用的最后一行，如果您知道只想转到 500，则可以使用整数：

Sub try2()

Sub try2()

  Dim i, Y, x As Long 'you didn't mention what Y was, so it could also be a string.
  Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index")
  Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get  you into trouble
  Dim Ary1 As Range
  Dim ary2 As Range


   x = 5
   Y = "Y" 'for the sake of argument
         'For i = 2 To ws1.Range("B65536").End(xlUp).Row   This is if you are looking for the last row in MsOf2003 or earlier.  If you know that you are only looking to row 500, then hard code the intiger.
   For i = 2 To 500:
        'If ws1.Cells(i, 2) = "Y" You mentioned you were interested in column J, so we need to change the 2 to 10 (Column B to Column J)
         If ws1.Cells(i, 10) = Y Then
            ws1.Activate
            Set Ary1 = Range(Cells(i, 3), Cells(i, 9))
            ws2.Activate
            Set ary2 = Range(Cells(x, 1), Cells(x, 7)) 'avoid copying all together you don't need it
            ary2.Value = Ary1.Value
            x = x + 1
         End If
   Next i
  End Sub

  Dim i, Y, x As Long 'you didn't mention what Y was, so it could also be a string.
  Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index")
  Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get  you into trouble
  Dim Ary1 As Range
  Dim ary2 As Range


   x = 5
   Y = "Y" 'for the sake of argument
         'For i = 2 To ws1.Range("B65536").End(xlUp).Row   This is if you are looking for the last row in MsOf2003 or earlier.  If you know that you are only looking to row 500, then hard code the intiger.
   For i = 2 To 500:
        'If ws1.Cells(i, 2) = "Y" You mentioned you were interested in column J, so we need to change the 2 to 10 (Column B to Column J)
         If ws1.Cells(i, 10) = Y Then
            ws1.Activate
            Set Ary1 = Range(Cells(i, 3), Cells(i, 9))
            ws2.Activate
            Set ary2 = Range(Cells(x, 1), Cells(x, 7)) 'avoid copying all together you don't need it
            ary2.Value = Ary1.Value
            x = x + 1
         End If
   Next i
  End Sub

I'm writing this on a phone not on a compiler, so there may be a syntax error in there and this should be seen as pseudo-VBA code. I can check later to see if you got it to work. You will have to watch out on where you put things if you don't want them to be overwritten.

我是在手机上而不是在编译器上写的，所以那里可能存在语法错误，这应该被视为伪 VBA 代码。我可以稍后检查你是否让它工作。如果您不希望它们被覆盖，您将不得不注意放置东西的位置。