Copying data between sheets if certain conditions are met

Question

I want to go through column D and if there is a "Yes" copy a number of cells that are constantly the same distance away from the cell in Column D that says "Yes".

For example if D23 says "Yes" then copy A23, A24, B22, and E22 side by side in a another sheet.

I recorded the code below. I attached the macro to a button. If I scroll to a cell in Column D that has "Yes" and click the button it does what I want. I don't know how to make it run the code on it's own through the entirety of column D.

Additionally it pastes on the side of the information. Is there a way to paste in a new sheet below the previous pasted data because currently there's a lot of empty space between the rows since the "yes" is only present every 20 rows or so.

Sub Test()  
 ' Test Macro

Range("A23").Select
Selection.Copy
Range("V23").Select
ActiveSheet.Paste
Range("A24").Select
Application.CutCopyMode = False
Selection.Copy
Range("W23").Select
ActiveSheet.Paste
Range("B22").Select
Application.CutCopyMode = False
Selection.Copy
Range("Y23").Select
ActiveSheet.Paste
Range("E22").Select
Application.CutCopyMode = False
Selection.Copy
Range("Z23").Select
ActiveSheet.Paste  

End Sub

I'm not quite sure I understand how the cells you've listed are a 'constant' distance away from the cell in column D. Do you mean for there to be overlap when you're copying? — Marcucciboy2, Aug 20 '18 at 14:07
For example, copying `D23` will grab `A23` and `A24`, so if it moved on to `D24` would you want it to grab `A24` (a second time) and `A25`? — Marcucciboy2, Aug 20 '18 at 14:09
I suggest to begin with the macro recorder. Then look at the code that it produced, read [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) and improve the code to your needs. Also have a look at the [Range.Offset Property](https://learn.microsoft.com/en-us/office/vba/api/Excel.Range.Offset) to learn how to move from a specific cell relatively. If you get stuck come back here [edit] your question and show the code you have written so far and tell us where your difficulties or errors are. — Pᴇʜ, Aug 20 '18 at 14:11

score 0 · Answer 1 · answered Aug 20 '18 at 14:46

Because you at least tried it, I suggest the following.

There is a For loop to loop through all rows with data and check for a "yes". If there is one then copy the data into a destination worksheet.

Option Explicit

Public Sub FindKeywordAndCopyData()
    Dim wsSource As Worksheet
    Set wsSource = ThisWorkbook.Worksheets("Data") 'define data sheet

    Dim wsDestination As Worksheet
    Set wsDestination = ThisWorkbook.Worksheets("Output") 'define output sheet

    Dim LastRow As Long
    LastRow = wsSource.Cells(Rows.Count, "D").End(xlUp).Row 'find last used row in column D

    Dim NextFreeRow As Long

    Dim iRow As Long
    For iRow = 2 To LastRow 'loop through all data rows (from row 2 to last used row)
        If wsSource.Cells(iRow, "D").Value = "yes" Then 'check if column D has a "yes"
            With wsDestination
                NextFreeRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 'find next empty row in destination sheet

                'copy the cell values to destination A, B, C, D
                .Cells(NextFreeRow, "A").Value = wsSource.Cells(iRow, "A").Value     'current row column A
                .Cells(NextFreeRow, "B").Value = wsSource.Cells(iRow + 1, "A").Value 'next row column A
                .Cells(NextFreeRow, "C").Value = wsSource.Cells(iRow - 1, "B").Value 'previous row column B
                .Cells(NextFreeRow, "D").Value = wsSource.Cells(iRow - 1, "E").Value 'previous row column E
            End With
        End If
    Next iRow
End Sub

Copying data between sheets if certain conditions are met

1 Answers1