Copying the data from one sheet to another on the basis of yes/no condition

I want to copy the selective data (Columns) from one excel sheet to another on a filter of yes and no .
Here is my excel
Now the problem is when i execute the code all the data of a particular column is copied and filter for yes and no is not working as per my code

Here is my code

Sub testIt()
Dim r As Long, endRow As Long

endRow = 20  ' of course it's best to retrieve the last used row number via a function
'pasteRangeIndex = 1

For r = 5 To endRow 'Loop through sheet1 and search for your criteria

    If Cells(r, Columns("H").Column).Value = "yes" Then 'Found

            'Copy the current cell
            
            
      
   Range("G1:G19").Select
   Selection.Copy
   Sheets("Sheet1").Select
   Range("A1:A19").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            
            
     Sheets("Sheet3").Select
   Range("C1:C19").Select
   Selection.Copy
   Sheets("Sheet1").Select
   Range("B1:B19").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   
   Sheets("Sheet3").Select
   Range("D1:D19").Select
   Selection.Copy
   Sheets("Sheet1").Select
   Range("C1:C19").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   
  
    
          
    End If

Next r


End Sub

Moderator Note:

Pls use code tags around your code next time as per forum rules.

Hi, and welcome to the forum. Unfortunately your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here However even with the code formatted correctly it's likely to be of little use unless we can see the workbook itself.

So upload the workbook and explain clearly what is your end goal. Manually add a typical result situation and say how you have arrived at it. Don't explain what your current macro is trying to do, we like to decide for ourselves what is the best approach and all we need to know is what you start with and what you want to end up with.



(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

Hi ,
I want all the data from Sheet1 to be copied to Sheet2 based on Yes condition only .

Following is my code but is giving everything including no condition data , however i need only "yes" one.
Open excel(questions1.xlsx - most updated) for more info.
Please Help.

<Code>
Sub testIt()
Dim r As Long, endRow As Long

endRow = 20 ' of course it's best to retrieve the last used row number via a function
'pasteRangeIndex = 1

For r = 5 To endRow 'Loop through sheet1 and search for your criteria

If Cells(r, Columns("H").Column).Value = "yes" Then 'Found

'Copy the current cell



Range("G1:G19").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1:A19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Sheets("Sheet3").Select
Range("C1:C19").Select
Selection.Copy
Sheets("Sheet1").Select
Range("B1:B19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Sheets("Sheet3").Select
Range("D1:D19").Select
Selection.Copy
Sheets("Sheet1").Select
Range("C1:C19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False




End If

Next r


End Sub
</Code>

Hi,

The easiest way for all these sorts of tasks is to use Data Filter


First put column labels above each of the columns in your data range, i.e. in A4:K4
Apply a dynamic range name to your data so that you don't need to worry about new records being added. i.e.

your name = =OFFSET(Sheet1!A4,0,0,COUNTA(Sheet1!A:A),11)

Now create a range of column labels on your output sheet. e.f. in say A5:G5 on sheet 2 copy your sheet 1 column labels. You don't need to copy them all if you only want a subset. Name this range of labels say "DataOut"

Create a Criteria range in say A1:A2 on sheet 2 with the column G label in A1 and the word "yes" in A2. Name A1:A2 say "Crit"

Now use the following macro

Sub FilterData
   Sheet1.Range("Data").AdvancedFilter Action:=xlFilterCopy, copytorange:=Sheet2.Range("DataOut"), criteriarange:=Sheet2.Range("Crit")

End Sub