VBA - Copy and paste entire row to second sheet based on cell value

cwdamron

New Member
Joined
Jul 11, 2013
Messages
9
Hello,

Today I finally taught myself a basic understanding of macros/VBA. I've made a lot of progress on my project, but am stuck at the moment...Here's what's going on:

I have a sheet titled "All Trades" that contains the raw data like the example below. I have two other sheets titled "As-Of Trades" and "Non As-Of Trades". I'm needing a code to copy the entire row of data from the "All Trades" sheet, and paste it in the next available row on the other two sheets, based on the value of YES or NO.

If Yes - Copy row to sheet titled "As-Of Trades"
If No - Copy row to sheet titled "Non As-Of Trades"

Any help is MUCH appreciated THANK YOU!!

FundAccountAmountGain/LossAs/Of? (Y/N)
111111$15000.00-$1.51YES
122222$32158.52$78.14YES
2123123$1.00$0.00NO

<TBODY>
</TBODY>
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Michael, I also borrowed this and it works just fine.. Although when I double click on it again as I add more information daily to this data sheet it duplicates the ones that it already ran. How can I get it to not repeat the data that is already moved over?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Xtra").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("Escalated Cases").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If Range("L" & r).Value = "YES" Then
Rows(r).Copy Destination:=Sheets("Escalated Cases").Range("A" & lr2 + 1)
lr2 = Sheets("Escalated Cases").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r

End Sub
 
Upvote 0
Try
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Xtra").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("Escalated Cases").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Escalated Cases").rows("1:" & lr2).delete
lr2 = Sheets("Escalated Cases").Cells(Rows.Count, "A").End(xlUp).RowFor r = lr To 2 Step -1
If Range("L" & r).Value = "YES" Then
Rows(r).Copy Destination:=Sheets("Escalated Cases").Range("A" & lr2 + 1)
lr2 = Sheets("Escalated Cases").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r

End Sub
 
Upvote 0
How would this be changed to copy only one cell instead of the entire the row? Thanks.

Try
Code:
Sub As_Of_Analysis_Sorting()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("All Trades").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row
lr3 = Sheets("Non-As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
    If Range("P" & r).Value = "YES" Then
        Rows(r).Copy Destination:=Sheets("As-Of Trades").Range("A" & lr2 + 1)
        lr2 = Sheets("As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row
    End If
    If Range("P" & r).Value = "NO" Then
        Rows(r).Copy Destination:=Sheets("Non-As-Of Trades").Range("A" & lr3 + 1)
        lr3 = Sheets("Non-As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row
    End If
    Range("A1").Select
Next r
End Sub
 
Upvote 0
Hi,

I Have found this thread very VERY useful so thank you in advanced for helping me get this far. The code below is close to what I want to do, but rather than copy and paste the entire row (which will remove any information in subsequent columns in the destination sheet), I want to be able to Copy a set of ranges e.g. AG:AK,AM,AP:AQ and past that range in a set range on the other sheet, e.g. A10:E10,G10,I10:J10, and then paste below this subsequently so data is not overwritten.

Can anyone help me please?!? Thank you

The code:
Sub Test_Info()

Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("OOR").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If Range("AM" & r).Value = Date - 1 Then
Rows(r).Copy Destination:=Sheets("Sheet3").Range("A" & lr2 + 1)
lr2 = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r
End Sub
 
Upvote 0
Dear All,

First of all let me thank you the entire forum for such an wonderful effort to help people.

I have created a thread for my request

http://www.mrexcel.com/forum/excel-questions/837102-changing-source-data-pivots.html#post4079954

Putting the details here as well for reference

I have a file where there are two tabs say name is "Actual Database" and "Forecast Database" and I have created number of different pivots using the data from the tab "Actual Database". I have created both the tabs using table options and named the tables as 'Actual' and 'Forecast'.

But What I am looking for is I will have a drop down with options "Actual" and "Forecast" which will be selected by the user. In case the user selects 'Actual', the source data for all the pivots should get from the 'Actual database' tab and in case the user selects 'Forecast' the source data for all the pivots should get from the 'Actual database' tab.

Can anyone help me sort out the above issue which I am unable to sort out.

Many Thanks in Advance

Vikash
 
Upvote 0
Could someone help me code this:

I am dealing with 2 spreadsheets. I would like for spreadsheet "SupportLog" to be updated with data from Sheet1 when there is a 0 (zero) in column T of Sheet1. The rows J-S need to move to a new row on Sheet1 to rows J-S only should be pasted.

Thanks so much! I have been trying to figure this out for a while now!
 
Upvote 0
pleasure...(y)

Hi Michael,

I have been recycling the code that you have written in this thread and it worked but after the rows are pasted on the new sheet in opposite order. For example, row 2 became the last row and the last row became the first row. Also, how can I modify the code to paste as values on the new sheet?

This is what I have now:

Private Sub CommandButton2_Click()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("FULL INFO FOR DRAW").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("MS").Cells(Rows.Count, "A").End(xlUp).Row
'lr3 = Sheets("MD").Cells(Rows.Count, "A").End(xlUp).Row
'lr4 = Sheets("WS").Cells(Rows.Count, "A").End(xlUp).Row
'lr5 = Sheets("WD").Cells(Rows.Count, "A").End(xlUp).Row
'lr6 = Sheets("XD").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If Range("I" & r).Value = "MS" Then
Rows(r).Copy Destination:=Sheets("MS").Range("A" & lr2 + 1)
lr2 = Sheets("MS").Cells(Rows.Count, "A").End(xlUp).Row
End If
' If Range("J" & r).Value = "MD" Then
' Rows(r).Copy Destination:=Sheets("MD").Range("A" & lr3 + 1)
' lr3 = Sheets("MD").Cells(Rows.Count, "A").End(xlUp).Row
' End If
' If Range("K" & r).Value = "WS" Then
' Rows(r).Copy Destination:=Sheets("WS").Range("A" & lr4 + 1)
' lr4 = Sheets("WS").Cells(Rows.Count, "A").End(xlUp).Row
' End If
' If Range("L" & r).Value = "WD" Then
' Rows(r).Copy Destination:=Sheets("WD").Range("A" & lr5 + 1)
' lr5 = Sheets("WD").Cells(Rows.Count, "A").End(xlUp).Row
' End If
' If Range("M" & r).Value = "XD" Then
' Rows(r).Copy Destination:=Sheets("XD").Range("A" & lr6 + 1)
' lr6 = Sheets("XD").Cells(Rows.Count, "A").End(xlUp).Row
' End If
Range("A1").Select
Next r
End Sub

Thank you,

Zoe
 
Upvote 0
This might also be a better option
Code:
Sub Macro2()
Dim lr As Long, lr2 As Long, lr3 As Long, lr4 As Long, r As Long
lr = Sheets("raw data").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("23047021 sundries").Cells(Rows.Count, "A").End(xlUp).Row
lr3 = Sheets("23048512 hygiene").Cells(Rows.Count, "A").End(xlUp).Row
lr4 = Sheets("23052521 equip").Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        Select Case Range("A" & r).Value
            Case Is = "23047021"
                Rows(r).Copy Destination:=Sheets("23047021 sundries").Range("A" & lr2 + 1)
                lr2 = Sheets("23047021 sundries").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "23048512"
                Rows(r).Copy Destination:=Sheets("23048512 hygiene").Range("A" & lr3 + 1)
                lr3 = Sheets("23048512 hygiene").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "23052521"
                Rows(r).Copy Destination:=Sheets("23052521 equip").Range("A" & lr4 + 1)
                lr4 = Sheets("23052521 equip").Cells(Rows.Count, "A").End(xlUp).Row
        End Select
    Next r
End Sub

Michael, I am looking to do something similar but, I need update the data regularly (ie. date in/ date out/ date approved...). With this code it keeps adding on to previous entry, it doesn't clear previous entry (starting with cell A2...) or update only the cells or rows that changed.
I have tired different things but, code above is the only one that has worked for me in extracting data to multiple sheets. I have total of 33 sheets (01, 02, 03...) and data in cell will always start with 01 ****, 02 ****... followed by space and more numbers different based on product.

Thank you in advance!

Nimesh
 
Upvote 0
Try
Code:
Sub As_Of_Analysis_Sorting()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("All Trades").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row
lr3 = Sheets("Non-As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
    If Range("P" & r).Value = "YES" Then
        Rows(r).Copy Destination:=Sheets("As-Of Trades").Range("A" & lr2 + 1)
        lr2 = Sheets("As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row
    End If
    If Range("P" & r).Value = "NO" Then
        Rows(r).Copy Destination:=Sheets("Non-As-Of Trades").Range("A" & lr3 + 1)
        lr3 = Sheets("Non-As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row
    End If
    Range("A1").Select
Next r
End Sub

Thank you for posting this it is a big help to me. I am doing something similar where I want the code to read through one sheet and post certain data that meets a criteria to a new row in a new sheet the code will create. I understand all of this code except for the "For r = lr To 2 Step -1. I get that you would want it to read through all of the rows on the primary sheet but I don't understand what "To 2 Step -1" does. Could you please explain that to me so I understand the code better?
 
Upvote 0

Forum statistics

Threads
1,215,471
Messages
6,124,999
Members
449,201
Latest member
Lunzwe73

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top