Copy Row over to another sheet with multiple criteria in multiple ranges VBA Excel

Question

I am trying to copy rows from one sheet to another using VBA, I need it to check cell in column a if it contains value X and if column C excludes Value Y.

I have come as far to copy it with the first criteria, but not the second.

This is what I have and it won't work...

Sub Copy_2016()
'
'Run Sub Copy_2016()
'
Sheets("Working - 2016").Select
Range("A3:AO6304").ClearContents

For Each Cell In Sheets("Working - Data").Range("A1:A6304,C3:C6304")
    If Cell.Value = "2016" And If Not Cell.Value = "HI" Then
         matchRow = Cell.Row
         Rows(matchRow & ":" & matchRow).Select
         Selection.Copy

         Sheets("Working - 2016").Select
         ActiveSheet.Rows(matchRow).Select
         ActiveSheet.Paste
         Sheets("Working - Data").Select
    End If
Next

End Sub

When you step through the code and look at the Cell.Value, don't you see that it does NOT contain both the column A AND the column C value? You seem to be expecting the first Cell.Value to contain the column A value, and the next time you refer to it you compare it with the column C value. Can you see the flaw in that approach? — teylyn
– teylyn, Commented Mar 29, 2017 at 2:33
Hi, thank you. Yes I can see that error, just not sure how I get it to say if in cell x is value and if not in cell y is another value, then... — Jay
– Jay, Commented Mar 29, 2017 at 5:49

Shai Rado · Accepted Answer · 2017-03-29 05:57:01Z

1

One thing @chris neilsen answer is missing, is that the pasted sheet ("Working - 2016") will have blank rows in the middle (since not all rows will be copied), that's why I added the RowDest variable.

Also, if all you do is paste the values, you can use Worksheets("Working - 2016").Rows(RowDest).value = Cell.EntireRow.value instead of Copy and PasteSpecial in 2 code lines.

Code

Option Explicit

Sub Copy_2016()

    Dim Cell As Range
    Dim RowDest As Long

    With Worksheets("Working - 2016")
        .Range("A3:AO6304").ClearContents
    End With

    RowDest = 3 ' first paste row , since you are clearing the sheet's contents
    With Worksheets("Working - Data")
        For Each Cell In .Range("A1:A6304")
            If Cell.value Like "2016" And Not Cell.Offset(0, 2).value Like "HI" Then
                Worksheets("Working - 2016").Rows(RowDest).value = Cell.EntireRow.value
                RowDest = RowDest + 1
            End If
        Next Cell
    End With

End Sub

edited Mar 29, 2017 at 5:57

answered Mar 29, 2017 at 5:54

Shai Rado

33.7k7 gold badges32 silver badges55 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Jay Over a year ago

Wow, thanks. This one works perfect, I don't get the blank rows inbetween!

Jay Over a year ago

Thanks, quick question... I tried adding it to another sheet to get the next data set... I get an error then and I cannot see the issue... can you please help with this? -----_> Never mind ( Found it, missed changing the RowDest = 3 to RD = 3 :)

chris neilsen · Accepted Answer · 2017-03-29 02:36:42Z

1

I think you need something like this

Sub Copy_2016()
    Dim Cell As Range
    Worksheets("Working - 2016").Range("A3:AO6304").ClearContents

    For Each Cell In Worksheets("Working - Data").Range("A1:A6304")
        If Cell.Value = "2016" And Not Cell.Offset(0, 2).Value = "HI" Then
            Cell.EntireRow.Copy
            Worksheets("Working - 2016").Rows(Cell.Row).PasteSpecial Paste:=xlPasteValues
        End If
    Next
End Sub

answered Mar 29, 2017 at 2:36

chris neilsen

53.3k10 gold badges91 silver badges127 bronze badges

Collectives™ on Stack Overflow

Copy Row over to another sheet with multiple criteria in multiple ranges VBA Excel

2 Answers 2

2 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related