Copy Data to next available row in new workbook if Cell - Yes

[CA Guy]

Hello,

I am quite new to using VBA coding. I am trying to find a solution to automate copying and pasting from one workbook to another.

I am making a Questions and Answers database Workbook for a project in its implementation phase and some questions are needing to be deferred to the Operational phase. As such I am hoping that if the column to defer has a "Yes" then it will move the corresponding data to a new Operational Phase Questions and Answers database Workbook.

In workbook1/Worksheet1
I have data in columns A-I
In column J, I have a "Yes/No" drop down menu.

What I'm want to achieve is:

If a cell in Workbook1/Worksheet1, Column J has a value = "Yes" then
Cut cell data in Columns A-I of the same row and paste them to the next available row, Columns A-I in Workbook2/Worksheet1 (preferably deleting the newly blank row in Workbook1/Worksheet1)

If Workbook1/Worksheet1, Column J is blank or ="No" do nothing.

Any assistance would be greatly appreciated. Thank you n advance.

 

[sijpie]

Hi CA Guy, welcome to the board. This forum is running for years now, with hundred of thousand questions already answered. You question is probably one of the most asked questions.
So do a search for instance on 'copy row to new workbook' . With a bit of digging you're bound to find some decent code. If you get stuck, then reply again to this thread

 

[CA Guy]

Hi CA Guy, welcome to the board. This forum is running for years now, with hundred of thousand questions already answered. You question is probably one of the most asked questions.
So do a search for instance on 'copy row to new workbook' . With a bit of digging you're bound to find some decent code. If you get stuck, then reply again to this thread, or send me a private message, and I will help you.

Hello sijpie,

Thank you for responding. I have be searching for days, and trying many different codes, for copy paste, cut paste, copy row if cell="Yes", but nothing seems to be working. Again, admittedly I am quite the novice, but I thinks it is something simple that I am missing.

Again, in Sheet1"Implementation Q&A Master List", I am hoping to cut data in a row "columns A-H", if in same row "column I" has a value of "Y", then paste the data into the next available row from columns A-H into Sheet2"Operational Q&A Master List". Then delete the blank row in Sheet1

Attached is a picture of my document (sorry I installed the l2bb Add-on, but it doesn't show up to add to custom ribbon).

Here are two VBA codes that I believe is the two closest to achieve what I am looking for. I have tried modifying the, but keep failing to produce the desired outcome. Any assistance on your part or guidance to specific info else where would be greatly appreciated.



'The Subs below are original code and have not been applied/modified for my Document.
______________________________________________________________________________

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
Dim r As Long
Application.EnableEvents = False
If Target.Value = "Yes" Then
r = Target.Row
If Not Intersect(Range("G:G"), Target) Is Nothing Then
Target.EntireRow.Cut Sheets("Closed").Cells(Rows.Count, 1).End(xlUp)(2)
Rows(r).Delete xlShiftUp
End If
End If
Application.EnableEvents = True

'If yes, then move row to another sheet

End Sub

___________________________________________________________________________________________

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ows As Worksheet
Dim nws As Worksheet
Dim lr As Long

' Set name of worksheet to copy to, and name of current sheet
Set nws = Sheets("Sheet2")
Set ows = ActiveSheet

' Exit if more than one cell updated
If Target.CountLarge > 1 Then Exit Sub

' Check to see if row > 1 and value is "Yes"
If (Target.Row > 1) And (Target.Value = "Yes") Then
' Find first blank row on new sheet
lr = nws.Cells(Rows.Count, "A").End(xlUp).Row + 1
' Copy to new sheet
Application.EnableEvents = False
ows.Rows(Target.Row).Copy nws.Cells(lr, "A")
' Delete old row
ows.Rows(Target.Row).Delete
Application.EnableEvents = True
End If

'VBA to cut and paste a row into another sheet if one of the cells meets criteria.

End Sub

 

[MARK858]

sorry I installed the l2bb Add-on, but it doesn't show up to add to custom ribbon)

You shouldn't need to add it to a custom ribbon, if you have added it correctly it should appear on your Home ribbon.

How is the "Yes" being generated by typing it in or by formula?

 

[CA Guy]

The Yes is being Typed

 

[MARK858]

What happens with the code below (see sample workbook using random data in the link)?

CA Guy.xlsm | Powered by Box

app.box.com

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.CountLarge > 1 Then Exit Sub

    Application.EnableEvents = False
    If Target.Column = 10 Then
        If Target.Value = "Yes" Then
            Intersect(Target.EntireRow, Columns("A:H")).Copy Sheets("Operational Q&A Master List").Cells(Rows.Count, 1).End(xlUp)(2)
            Target.EntireRow.Delete xlShiftUp
        End If
    End If
    Application.EnableEvents = True

    'If yes, then move row to another sheet

End Sub

 

[CA Guy]

What happens with the code below (see sample workbook using random data in the link)?

CA Guy.xlsm | Powered by Box

app.box.com

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.CountLarge > 1 Then Exit Sub

    Application.EnableEvents = False
    If Target.Column = 10 Then
        If Target.Value = "Yes" Then
            Intersect(Target.EntireRow, Columns("A:H")).Copy Sheets("Operational Q&A Master List").Cells(Rows.Count, 1).End(xlUp)(2)
            Target.EntireRow.Delete xlShiftUp
        End If
    End If
    Application.EnableEvents = True

    'If yes, then move row to another sheet

End Sub

This is Exactly what I was needing Thank you soooooo sooooo much. I really appreciate all of the help.

 

[MARK858]

You're welcome