Copy specific cells to another sheet

Question

I have workbook in Excel with 2 sheets (2017 and 2018).

I want to take certain cells from sheet 2017 and copy them to sheet 2018 when a certain value is entered into a specific cell in the same row.

For example: In sheet 2017, in cell A2, if a "X" is entered, I want cell B2, C2 and G2 to be copied to sheet 2018. In sheet 2018, they should be copied to the next empty row and deleted from sheet 2017. And so on for every row in 2017 that has "X" in Column A.

Can anybody help me with this VBA headache?

YasserKhalil YasserKhalil · Accepted Answer · 2018-02-24T08:24:51

Try this code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim e           As Variant
    Dim lr          As Long
    Dim r           As Long

    If Target.Count = 1 And Target.Column = 1 Then
        With Sheets("2018")
            lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1
            r = Target.Row

            If Target = "X" Then
                Application.EnableEvents = False
                    For Each e In Array("B", "C", "G")
                        .Range(e & lr) = Range(e & r)
                        Range(e & r).ClearContents
                    Next e
                Application.EnableEvents = True
            End If
        End With
    End If
End Sub

And if you need to make it using a button for all the rows you can use this code

Sub Test()
    Dim ws          As Worksheet
    Dim e           As Variant
    Dim lr          As Long
    Dim r           As Long

    Set ws = ThisWorkbook.Sheets("2017")
    
    With Sheets("2018")
        For r = 1 To ws.Cells(Rows.Count, 2).End(xlUp).Row
            If ws.Cells(r, 1) = "X" Then
                lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1
                For Each e In Array("B", "C", "G")
                    .Range(e & lr) = ws.Range(e & r)
                    ws.Range(e & r).ClearContents
                Next e
            End If
        Next r
    End With
End Sub

Or it would be better if you used filter method

Copy specific cells to another sheet

1 Answers