VBA Code for Conditional Copying of Columns Not Adjacent to each other

Question

Project Master

In MS Excel using VBA, I would like some help on conditional copying between worksheets within the same workbook. As per the attached image, I have a master list of projects on the worksheet "Master". For all the projects that have a "yes" in column I (Defect), I would like to copy the values in columns A (Works Package Issue Date), B (Project No.), E (City) and H (Contract Value) to another worksheet "Defects", within the same workbook. Can you please provide a coding which could: a) collapse all the rows so there is no blank rows in "Defects" worksheet; and b) leave all the rows so if the "Defect" column has a "No", the relevant row from the "Master" worksheet is copied as a blank row in the "Defect" worksheet, if possible. Please help me with the coding - I have very basic knowledge of macros, and in a process of learning how to code. Thanks & Regards, CK

Answer 1

Try this to get you started. Also, in the future, please post what code you have, what errors you are getting, or a specific problem you are having instead of asking for code to solve a problem. There are many other posters here who will simply down vote you or remove your post if you do not show that you have put forth some effort to come up with a solution on your own.

Sub CopyValues()

'Declare variables
'Declare sheet variables
Dim Masterws as Worksheet
Dim Defectws as worksheet

'Declare counter variables
Dim I as Integer
Dim n as Integer

'Set value of sheet variables
Set Masterws=ThisWorkbook.Sheets("Master")
Set Defectws=ThisWorkbook.Sheets("Defects")

'Set value of counter to track first available row on Defects sheet
n=1

'Start a For loop to check each row on Master sheet, starting with row 2
For I = 2 to WorksheetFunction.CountA(Masterws.Columns.EntireColumn(1))

    'If the cells in row I, column I have a value of, "Yes," then execute some code. If not, continue on.
    If Cells(I, "I").value= "Yes" Then

        'Set the value of cells in row n of the Defects sheet to the corresponding values of row I in the Master sheet. If n is replaced with I, then the value of cells in row I on Defects will be set to the values of Row I on Master, leaving blank rows where no, "Yes," was found because no copying took place.
        Defectws.Cells(n,"A").Value=Masterws.cells(I,"A")
        Defectws.Cells(n,"B").Value=Masterws.cells(I,"B")
        Defectws.Cells(n,"C").Value=Masterws.cells(I,"E")
        Defectws.Cells(n,"D").Value=Masterws.cells(I,"H")

        'Add 1 to the n counter. The next time a row is found in the Master sheet with, "Yes," it will be written to the next available row down on the Defects sheet.
        n=n+1

    End If

'End of the For loop. Move on to the next row on Master sheet
Next

End Sub

Answer 2

@asp8811 Thanks for the codes, it works well. Sorry that I didn't put earlier what I have already - I am new to Stack Overflow, and new to coding - will always start off with my codes going forward. Below is what I have so far - combining your code and answer to another question I asked before. Your code works well to give me the ability to choose columns of my choice, unlike what I have below - which prints all the columns between A and H. My challenge is that I want to keep the rows (as blank rows) if there is a "No" in Defects column - which is what I have below, but I also want to report on just those columns not adjacent to each other and be able to select columns like you have.

Sub CopyValues()

Dim Masterws As Worksheet
Dim Defectws As Worksheet
Dim I As Integer
Dim n As Integer

Set Masterws = ThisWorkbook.Sheets("Master")
Set Defectws = ThisWorkbook.Sheets("Defects")

n = 1

For I = 2 To WorksheetFunction.CountA(Masterws.Columns.EntireColumn(1))

    If (Masterws.Range("J" & I) = "Yes") Then
    Masterws.Range("A" & I & ":H" & I).Copy Destination:=Worksheets("Defects").Range("A" & I)

   n = n + 1
   End If

Next
End Sub