0
votes

Trying to write a macro in VBA for Excel to look at the value in a certain column from each row of data in a list and if that value is "yes" then it copies and pastes the entire row onto a different sheet in the same workbook. Let's name the two sheets "Data" and "Final". I want to have the sheets referenced so it does not matter which sheet I have open when it runs the code. I was going to use a Do loop to cycle through the rows on the one data sheet until it finds there are no more entries, and if statements to check the values.

I am confused about how to switch from one sheet to the next.

How do I specifically reference cells in different sheets?

Here is the pseudocode I had in mind:

Do while DataCells(x,1).Value <> " "
    for each DataCells(x,1).Value="NO"
        if DataCells(x,2).Value > DataCells(x,3).Value or _
        DataCells(x,4).Value < DataCells(x,5).Value 
            'Copy and paste/insert row x from Data to Final sheet adding a new 
            'row for each qualifying row
        else
            x=x+1
        end
    else if DataCells(x,1).Value="YES"   
Loop
'copy and paste entire row to a third sheet
'continue this cycle until all rows in the data sheet are examined
1
You need to format the code more clearly; as it stands right now, the code is unreadable due to lack of lines or indentation.LittleBobbyTables - Au Revoir
Please use the Search feature.user2140261

1 Answers

0
votes
Sub FilterAndCopy()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim sh As Worksheet, sh2 As Worksheet
Dim lastrow1 As Long
Dim lastcolumn1 As Long



Set sh = ThisWorkbook.Sheets("Data")
Set sh2 = ThisWorkbook.Sheets("Final")

lastrow1 = sh.Cells(Rows.Count, "A").End(xlUp).Row ' Replace "A" With column that has the most Rows
lastcolumn1 = sh.Cells(1, Columns.Count).End(xlToLeft).Column

With sh.Range(.Cells(1, 1), .Cells(lastrow1, lastcolumn1))

'Replace the number in the field section with your Columns number
    .AutoFilter , _
        Field:=1, _
        Criteria1:="yes"

    .Copy sh2.Range("A1")

End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub