且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

VBA代码将选定的列从符合条件的行复制到另一个工作表

更新时间:2022-10-15 12:25:19

这是更优雅的解决方案,更类似于我的原始帖子。唯一的区别是单元格引用符合正确的表格。

  Sub try3()
Dim i,x As Long
Dim Y as String
Dim ws1 As Worksheet:设置ws1 = ActiveWorkbook.Sheets(Index)
Dim ws2 As Worksheet:设置ws2 = ActiveWorkbook.Sheets(Sheet2)'活动工作表让你陷入困境

x = 5
Y =Y
对于i = 2到500:
如果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))。 b $ bx = x + 1
End If
Next i
End Sub


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

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 Only of 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.

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

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

Thanks for all your help so far.

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.

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