VBA code to copy selected columns from rows that m

2019-08-02 07:18发布

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.

2条回答
做个烂人
2楼-- · 2019-08-02 07:58

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

查看更多
男人必须洒脱
3楼-- · 2019-08-02 08:02

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:

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

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.

查看更多
登录 后发表回答