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

cwdamron · Jul 21, 2013

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!!

Fund	Account	Amount	Gain/Loss	As/Of? (Y/N)
1	11111	$15000.00	-$1.51	YES
1	22222	$32158.52	$78.14	YES
2	123123	$1.00	$0.00	NO

crater · May 18, 2016

Hello,

I am in need of some assistance. I am maintaining a workbook with 12 different worksheets. One of those sheets tracks personnel on staff (ROSTER) and another tracks the people that have left during the fiscal year (LOSSES). In the last column of the ROSTER has a drop down box for the status, for this example we will say HIRE, TERM, or END. Below is a sample. What I am needing is when a person is marked as TERM or END, that row is copied to the LOSSES sheet and cleared out of the ROSTER sheet. One constraint is that I need to maintain the number of rows and formulas in the ROSTER sheet due to other sheets pulling information from it. Also, the ROSTER sheet has to remain sortable. I hope this all makes since.

Here is a sample ROSTER:

	A	B	C	D	E	F	G	H	I
2	Checked In	Last Name	First Name	Title	Phone	Report	Depart	Location	Remarks
3	X	Smith	John	Asst	123-456-7890	5/18/2016	5/18/2018	Here	Hire
4	X	Jones	Jacob	Mgr	234-567-8901	4/18/2016	4/18/2018	There	Term
5	X	Schmidt	Jingleheimer	Dep	345-678-9012	3/18/2016	3/18/2018	Dunno	End

So far I have been able to come up with the following code:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("I:I")) <> "Term" And Intersect(Target, Columns("I:I")) <> "End" Then Exit Sub

If Target.Value = "Term" Then
Range(Cells(Target.Row, "A"), Cells(Target.Row, "I")).Copy _
Sheets("LOSSES").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If

If Target.Value = "Term" Then Range(Cells(Target.Row, "A"), Cells(Target.Row, "I")).ClearContents

If Target.Value = "End" Then
Range(Cells(Target.Row, "A"), Cells(Target.Row, "I")).Copy _
Sheets("LOSSES").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If

If Target.Value = "End" Then Range(Cells(Target.Row, "A"), Cells(Target.Row, "I")).ClearContents

On Error Resume Next
End Sub

I am running into the following issues:
Anytime I change the values of a cell (other than Column I) I get Run-time error '91'
When I change the value in Column I to either TERM or END, the row copies over fine, but I lose my formulas in the ROSTER sheet.

Any help will be greatly appreciated.

Blaise · Jul 27, 2016

Michael M said:

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

Dear Michael,

I've just found this thread searching for a solution to my problem to be solved to which your code could be the solution, but unfortunately I'm not familiar with VBA coding so I couldn't modify your code.

I have a product list in Product.sheet containing the Group code in column D. (e.g. 'A' stands for Windows, 'B' stands for Doors, 'C' stands for Wood products, etc.) There can be hundreds of rows in this table.

I would need a code that does the following:
- Based on the value in column D it copies each entire rows into a given sheet according to the following rules: A goes to SheetA, B goes to SheetB, D goes to SheetC, etc ... till Z. (There's no C and R !!)

I tried to figure out the solution, but it's not working.

If needed, I can send the xlsm file (I couldn't find how I can attach)
Any help would be highly appreciated.

Thank you in advance,
Balazs

Code:

Private Sub CommandButton2_Click()

Dim lr As Long, lr2 As Long, lr3 As Long, lr4 As Long, lr5 As Long, lr6 As Long, lr7 As Long, lr8 As Long, lr9 As Long, lr10 As Long, lr11 As Long, lr12 As Long, lr13 As Long, lr14 As Long, lr15 As Long, lr16 As Long, lr17 As Long, lr18 As Long, lr19 As Long, lr20 As Long, lr21 As Long, lr22 As Long, lr23 As Long, lr24 As Long, lr25 As Long, r As Long
lr = Sheets("Product.sheet").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("SheetA").Cells(Rows.Count, "A").End(xlUp).Row
lr3 = Sheets("SheetB").Cells(Rows.Count, "A").End(xlUp).Row
lr4 = Sheets("SheetD").Cells(Rows.Count, "A").End(xlUp).Row
lr5 = Sheets("SheetE").Cells(Rows.Count, "A").End(xlUp).Row
lr6 = Sheets("SheetF").Cells(Rows.Count, "A").End(xlUp).Row
lr7 = Sheets("SheetG").Cells(Rows.Count, "A").End(xlUp).Row
lr8 = Sheets("SheetH").Cells(Rows.Count, "A").End(xlUp).Row
lr9 = Sheets("SheetI").Cells(Rows.Count, "A").End(xlUp).Row
lr10 = Sheets("SheetJ").Cells(Rows.Count, "A").End(xlUp).Row
lr11 = Sheets("SheetK").Cells(Rows.Count, "A").End(xlUp).Row
lr12 = Sheets("SheetL").Cells(Rows.Count, "A").End(xlUp).Row
lr13 = Sheets("SheetM").Cells(Rows.Count, "A").End(xlUp).Row
lr14 = Sheets("SheetN").Cells(Rows.Count, "A").End(xlUp).Row
lr15 = Sheets("SheetO").Cells(Rows.Count, "A").End(xlUp).Row
lr16 = Sheets("SheetP").Cells(Rows.Count, "A").End(xlUp).Row
lr17 = Sheets("SheetQ").Cells(Rows.Count, "A").End(xlUp).Row
lr18 = Sheets("SheetS").Cells(Rows.Count, "A").End(xlUp).Row
lr19 = Sheets("SheetT").Cells(Rows.Count, "A").End(xlUp).Row
lr20 = Sheets("SheetU").Cells(Rows.Count, "A").End(xlUp).Row
lr21 = Sheets("SheetV").Cells(Rows.Count, "A").End(xlUp).Row
lr22 = Sheets("SheetW").Cells(Rows.Count, "A").End(xlUp).Row
lr23 = Sheets("SheetX").Cells(Rows.Count, "A").End(xlUp).Row
lr24 = Sheets("SheetY").Cells(Rows.Count, "A").End(xlUp).Row
lr25 = Sheets("SheetZ").Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        Select Case Range("D" & r).Value
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetA").Range("A" & lr2 + 1)
                lr2 = Sheets("SheetA").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetB").Range("A" & lr3 + 1)
                lr3 = Sheets("SheetB").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetD").Range("A" & lr4 + 1)
                lr4 = Sheets("SheetD").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetE").Range("A" & lr5 + 1)
                lr5 = Sheets("SheetE").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetF").Range("A" & lr6 + 1)
                lr6 = Sheets("SheetF").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetG").Range("A" & lr7 + 1)
                lr7 = Sheets("SheetG").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetH").Range("A" & lr8 + 1)
                lr8 = Sheets("SheetH").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetI").Range("A" & lr9 + 1)
                lr9 = Sheets("SheetI").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetJ").Range("A" & lr10 + 1)
                lr10 = Sheets("SheetJ").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetK").Range("A" & lr11 + 1)
                lr11 = Sheets("SheetK").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetL").Range("A" & lr12 + 1)
                lr12 = Sheets("SheetL").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetM").Range("A" & lr13 + 1)
                lr13 = Sheets("SheetM").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetN").Range("A" & lr14 + 1)
                lr14 = Sheets("SheetN").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetO").Range("A" & lr15 + 1)
                lr15 = Sheets("SheetO").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetP").Range("A" & lr16 + 1)
                lr16 = Sheets("SheetP").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetQ").Range("A" & lr17 + 1)
                lr17 = Sheets("SheetQ").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetS").Range("A" & lr18 + 1)
                lr18 = Sheets("SheetS").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetT").Range("A" & lr19 + 1)
                lr19 = Sheets("SheetT").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetU").Range("A" & lr20 + 1)
                lr20 = Sheets("SheetU").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetV").Range("A" & lr21 + 1)
                lr21 = Sheets("SheetV").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetW").Range("A" & lr22 + 1)
                lr22 = Sheets("SheetW").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetX").Range("A" & lr23 + 1)
                lr23 = Sheets("SheetX").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetY").Range("A" & lr24 + 1)
                lr24 = Sheets("SheetY").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetZ").Range("A" & lr25 + 1)
                lr25 = Sheets("SheetZ").Cells(Rows.Count, "A").End(xlUp).Row
        End Select
    Next r
End Sub

Blaise · Jul 29, 2016

Dear Michael,

One more thing I forgot to mention:
On the Product.sheet there are no entries in Column A, the product names are listed in Column B, and the group codes are in Column D.
And the first row of the table is freezed, there are some links only.

Thank you for your efforts in advance.

Kind rgds,
Balazs

Blaise · Jul 29, 2016

Blaise said:

Dear Michael,

I've just found this thread searching for a solution to my problem to be solved to which your code could be the solution, but unfortunately I'm not familiar with VBA coding so I couldn't modify your code.

I have a product list in Product.sheet containing the Group code in column D. (e.g. 'A' stands for Windows, 'B' stands for Doors, 'C' stands for Wood products, etc.) There can be hundreds of rows in this table.

I would need a code that does the following:
- Based on the value in column D it copies each entire rows into a given sheet according to the following rules: A goes to SheetA, B goes to SheetB, D goes to SheetC, etc ... till Z. (There's no C and R !!)

I tried to figure out the solution, but it's not working.

If needed, I can send the xlsm file (I couldn't find how I can attach)
Any help would be highly appreciated.

Thank you in advance,
Balazs

Code:

Private Sub CommandButton2_Click()

Dim lr As Long, lr2 As Long, lr3 As Long, lr4 As Long, lr5 As Long, lr6 As Long, lr7 As Long, lr8 As Long, lr9 As Long, lr10 As Long, lr11 As Long, lr12 As Long, lr13 As Long, lr14 As Long, lr15 As Long, lr16 As Long, lr17 As Long, lr18 As Long, lr19 As Long, lr20 As Long, lr21 As Long, lr22 As Long, lr23 As Long, lr24 As Long, lr25 As Long, r As Long
lr = Sheets("Product.sheet").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("SheetA").Cells(Rows.Count, "A").End(xlUp).Row
lr3 = Sheets("SheetB").Cells(Rows.Count, "A").End(xlUp).Row
lr4 = Sheets("SheetD").Cells(Rows.Count, "A").End(xlUp).Row
lr5 = Sheets("SheetE").Cells(Rows.Count, "A").End(xlUp).Row
lr6 = Sheets("SheetF").Cells(Rows.Count, "A").End(xlUp).Row
lr7 = Sheets("SheetG").Cells(Rows.Count, "A").End(xlUp).Row
lr8 = Sheets("SheetH").Cells(Rows.Count, "A").End(xlUp).Row
lr9 = Sheets("SheetI").Cells(Rows.Count, "A").End(xlUp).Row
lr10 = Sheets("SheetJ").Cells(Rows.Count, "A").End(xlUp).Row
lr11 = Sheets("SheetK").Cells(Rows.Count, "A").End(xlUp).Row
lr12 = Sheets("SheetL").Cells(Rows.Count, "A").End(xlUp).Row
lr13 = Sheets("SheetM").Cells(Rows.Count, "A").End(xlUp).Row
lr14 = Sheets("SheetN").Cells(Rows.Count, "A").End(xlUp).Row
lr15 = Sheets("SheetO").Cells(Rows.Count, "A").End(xlUp).Row
lr16 = Sheets("SheetP").Cells(Rows.Count, "A").End(xlUp).Row
lr17 = Sheets("SheetQ").Cells(Rows.Count, "A").End(xlUp).Row
lr18 = Sheets("SheetS").Cells(Rows.Count, "A").End(xlUp).Row
lr19 = Sheets("SheetT").Cells(Rows.Count, "A").End(xlUp).Row
lr20 = Sheets("SheetU").Cells(Rows.Count, "A").End(xlUp).Row
lr21 = Sheets("SheetV").Cells(Rows.Count, "A").End(xlUp).Row
lr22 = Sheets("SheetW").Cells(Rows.Count, "A").End(xlUp).Row
lr23 = Sheets("SheetX").Cells(Rows.Count, "A").End(xlUp).Row
lr24 = Sheets("SheetY").Cells(Rows.Count, "A").End(xlUp).Row
lr25 = Sheets("SheetZ").Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        Select Case Range("D" & r).Value
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetA").Range("A" & lr2 + 1)
                lr2 = Sheets("SheetA").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetB").Range("A" & lr3 + 1)
                lr3 = Sheets("SheetB").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetD").Range("A" & lr4 + 1)
                lr4 = Sheets("SheetD").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetE").Range("A" & lr5 + 1)
                lr5 = Sheets("SheetE").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetF").Range("A" & lr6 + 1)
                lr6 = Sheets("SheetF").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetG").Range("A" & lr7 + 1)
                lr7 = Sheets("SheetG").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetH").Range("A" & lr8 + 1)
                lr8 = Sheets("SheetH").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetI").Range("A" & lr9 + 1)
                lr9 = Sheets("SheetI").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetJ").Range("A" & lr10 + 1)
                lr10 = Sheets("SheetJ").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetK").Range("A" & lr11 + 1)
                lr11 = Sheets("SheetK").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetL").Range("A" & lr12 + 1)
                lr12 = Sheets("SheetL").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetM").Range("A" & lr13 + 1)
                lr13 = Sheets("SheetM").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetN").Range("A" & lr14 + 1)
                lr14 = Sheets("SheetN").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetO").Range("A" & lr15 + 1)
                lr15 = Sheets("SheetO").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetP").Range("A" & lr16 + 1)
                lr16 = Sheets("SheetP").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetQ").Range("A" & lr17 + 1)
                lr17 = Sheets("SheetQ").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetS").Range("A" & lr18 + 1)
                lr18 = Sheets("SheetS").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetT").Range("A" & lr19 + 1)
                lr19 = Sheets("SheetT").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetU").Range("A" & lr20 + 1)
                lr20 = Sheets("SheetU").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetV").Range("A" & lr21 + 1)
                lr21 = Sheets("SheetV").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetW").Range("A" & lr22 + 1)
                lr22 = Sheets("SheetW").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetX").Range("A" & lr23 + 1)
                lr23 = Sheets("SheetX").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetY").Range("A" & lr24 + 1)
                lr24 = Sheets("SheetY").Cells(Rows.Count, "A").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetZ").Range("A" & lr25 + 1)
                lr25 = Sheets("SheetZ").Cells(Rows.Count, "A").End(xlUp).Row
        End Select
    Next r
End Sub

Dear Michael,

Meantime, after some searching on the net and studying the meaning of ".Cells(Rows.Count, "A").End(xlUp).Row" I managed to find the problem in my code (I had to change it from "A" to "B" since thee were no entries in column A), now it's working perfectly.

Thank you anyway,
Balazs

Here's the right one:

Code:

Private Sub CommandButton2_Click()

Dim lr As Long, lr2 As Long, lr3 As Long, lr4 As Long, lr5 As Long, lr6 As Long, lr7 As Long, lr8 As Long, lr9 As Long, lr10 As Long, lr11 As Long, lr12 As Long, lr13 As Long, lr14 As Long, lr15 As Long, lr16 As Long, lr17 As Long, lr18 As Long, lr19 As Long, lr20 As Long, lr21 As Long, lr22 As Long, lr23 As Long, lr24 As Long, lr25 As Long, r As Long
lr = Sheets("Product.sheet").Cells(Rows.Count, "B").End(xlUp).Row
lr2 = Sheets("SheetA").Cells(Rows.Count, "B").End(xlUp).Row
lr3 = Sheets("SheetB").Cells(Rows.Count, "B").End(xlUp).Row
lr4 = Sheets("SheetD").Cells(Rows.Count, "B").End(xlUp).Row
lr5 = Sheets("SheetE").Cells(Rows.Count, "B").End(xlUp).Row
lr6 = Sheets("SheetF").Cells(Rows.Count, "B").End(xlUp).Row
lr7 = Sheets("SheetG").Cells(Rows.Count, "B").End(xlUp).Row
lr8 = Sheets("SheetH").Cells(Rows.Count, "B").End(xlUp).Row
lr9 = Sheets("SheetI").Cells(Rows.Count, "B").End(xlUp).Row
lr10 = Sheets("SheetJ").Cells(Rows.Count, "B").End(xlUp).Row
lr11 = Sheets("SheetK").Cells(Rows.Count, "B").End(xlUp).Row
lr12 = Sheets("SheetL").Cells(Rows.Count, "B").End(xlUp).Row
lr13 = Sheets("SheetM").Cells(Rows.Count, "B").End(xlUp).Row
lr14 = Sheets("SheetN").Cells(Rows.Count, "B").End(xlUp).Row
lr15 = Sheets("SheetO").Cells(Rows.Count, "B").End(xlUp).Row
lr16 = Sheets("SheetP").Cells(Rows.Count, "B").End(xlUp).Row
lr17 = Sheets("SheetQ").Cells(Rows.Count, "B").End(xlUp).Row
lr18 = Sheets("SheetS").Cells(Rows.Count, "B").End(xlUp).Row
lr19 = Sheets("SheetT").Cells(Rows.Count, "B").End(xlUp).Row
lr20 = Sheets("SheetU").Cells(Rows.Count, "B").End(xlUp).Row
lr21 = Sheets("SheetV").Cells(Rows.Count, "B").End(xlUp).Row
lr22 = Sheets("SheetW").Cells(Rows.Count, "B").End(xlUp).Row
lr23 = Sheets("SheetX").Cells(Rows.Count, "B").End(xlUp).Row
lr24 = Sheets("SheetY").Cells(Rows.Count, "B").End(xlUp).Row
lr25 = Sheets("SheetZ").Cells(Rows.Count, "B").End(xlUp).Row
    For r = lr To 2 Step -1
        Select Case Range("D" & r).Value
            Case Is = "A"
                Rows(r).Copy Destination:=Sheets("SheetA").Range("A" & lr2 + 1)
                lr2 = Sheets("SheetA").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "B"
                Rows(r).Copy Destination:=Sheets("SheetB").Range("A" & lr3 + 1)
                lr3 = Sheets("SheetB").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "D"
                Rows(r).Copy Destination:=Sheets("SheetD").Range("A" & lr4 + 1)
                lr4 = Sheets("SheetD").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "E"
                Rows(r).Copy Destination:=Sheets("SheetE").Range("A" & lr5 + 1)
                lr5 = Sheets("SheetE").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "F"
                Rows(r).Copy Destination:=Sheets("SheetF").Range("A" & lr6 + 1)
                lr6 = Sheets("SheetF").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "G"
                Rows(r).Copy Destination:=Sheets("SheetG").Range("A" & lr7 + 1)
                lr7 = Sheets("SheetG").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "H"
                Rows(r).Copy Destination:=Sheets("SheetH").Range("A" & lr8 + 1)
                lr8 = Sheets("SheetH").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "I"
                Rows(r).Copy Destination:=Sheets("SheetI").Range("A" & lr9 + 1)
                lr9 = Sheets("SheetI").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "J"
                Rows(r).Copy Destination:=Sheets("SheetJ").Range("A" & lr10 + 1)
                lr10 = Sheets("SheetJ").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "K"
                Rows(r).Copy Destination:=Sheets("SheetK").Range("A" & lr11 + 1)
                lr11 = Sheets("SheetK").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "L"
                Rows(r).Copy Destination:=Sheets("SheetL").Range("A" & lr12 + 1)
                lr12 = Sheets("SheetL").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "M"
                Rows(r).Copy Destination:=Sheets("SheetM").Range("A" & lr13 + 1)
                lr13 = Sheets("SheetM").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "N"
                Rows(r).Copy Destination:=Sheets("SheetN").Range("A" & lr14 + 1)
                lr14 = Sheets("SheetN").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "O"
                Rows(r).Copy Destination:=Sheets("SheetO").Range("A" & lr15 + 1)
                lr15 = Sheets("SheetO").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "P"
                Rows(r).Copy Destination:=Sheets("SheetP").Range("A" & lr16 + 1)
                lr16 = Sheets("SheetP").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "Q"
                Rows(r).Copy Destination:=Sheets("SheetQ").Range("A" & lr17 + 1)
                lr17 = Sheets("SheetQ").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "S"
                Rows(r).Copy Destination:=Sheets("SheetS").Range("A" & lr18 + 1)
                lr18 = Sheets("SheetS").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "T"
                Rows(r).Copy Destination:=Sheets("SheetT").Range("A" & lr19 + 1)
                lr19 = Sheets("SheetT").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "U"
                Rows(r).Copy Destination:=Sheets("SheetU").Range("A" & lr20 + 1)
                lr20 = Sheets("SheetU").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "V"
                Rows(r).Copy Destination:=Sheets("SheetV").Range("A" & lr21 + 1)
                lr21 = Sheets("SheetV").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "W"
                Rows(r).Copy Destination:=Sheets("SheetW").Range("A" & lr22 + 1)
                lr22 = Sheets("SheetW").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "X"
                Rows(r).Copy Destination:=Sheets("SheetX").Range("A" & lr23 + 1)
                lr23 = Sheets("SheetX").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "Y"
                Rows(r).Copy Destination:=Sheets("SheetY").Range("A" & lr24 + 1)
                lr24 = Sheets("SheetY").Cells(Rows.Count, "B").End(xlUp).Row
            Case Is = "Z"
                Rows(r).Copy Destination:=Sheets("SheetZ").Range("A" & lr25 + 1)
                lr25 = Sheets("SheetZ").Cells(Rows.Count, "B").End(xlUp).Row
        End Select
    Next r
End Sub

ptjimmons · Nov 28, 2016

Hey everyone, this thread has been awesome and very helpful, but I've run into a new problem. After successfully pasting the data from the original sheet into the two new ones, the lines are still in their original positions (ie, line 5 on the original sheet is pasted into line 5 of the destination sheet). Is it possible for them to start at the top of the new sheets? Here's the code as I have it now.

Code:

Sub EGS_CVS_Sorting()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("template").Cells(Rows.Count, "L").End(xlUp).Row
lr2 = Sheets("EGS lines").Cells(Rows.Count, "L").End(xlUp).Row
lr3 = Sheets("CVS lines").Cells(Rows.Count, "L").End(xlUp).Row
    For r = lr To 2 Step -1
        Select Case Range("L" & r).Value
            Case Is = "1a"
                Rows(r).Copy Destination:=Sheets("EGS lines").Range("A" & lr2 + 1)
                lr2 = Sheets("EGS lines").Cells(Rows.Count, "L").End(xlUp).Row
            Case Is = "1b"
                Rows(r).Copy Destination:=Sheets("CVS lines").Range("A" & lr2 + 1)
                lr2 = Sheets("CVS lines").Cells(Rows.Count, "L").End(xlUp).Row
        End Select
     Next r
    
End Sub

Thanks!

mjwatson · Feb 1, 2017

This is magic and works a treat, was really easy to modify too.
Thankyou folks

salemnj1 · Apr 20, 2018

all these years later this came in super handy for me. thanks!

Frank_I · Apr 19, 2020

Michael M said:

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

Hello Mike,

I am having trouble with this problem and I am hoping you may be able to assist. Upon a change from A2:Q2 (Real time Data from an exterior platform/website), A2:Q2 must copy to A3:Q3 and store the new value, then a new change in A2:Q2 will copy A2:Q2, fill down to A3:G3 while the previous data that was "stored" in A3:Q3 will move down to A4:Q4 and so on. In summary, A2:Q2 will constantly have new Data, and each row below should fill and store the "old" Data upon a change.

I have found a very similar example in this YouTube video below from 3:17-3:49

<< unavailable video removed >>

...Right now my code looks like this:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:Q2")) Is Nothing Then
Range("A3:Q3").Select
Selection.FillDown
ActiveCell.Select
End If
End Sub

tfmeier · Jul 29, 2020

Michael M said:

Try

Code:

Sub MM1()
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
For r = lr To 2 Step -1
    If Range("E" & 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
Next r
End Sub

Have adopted this code for a similar requirement. However the source data (i.e. All Trades in this code example) has links to other sheets to pull conditional data from. Now when the rows are copied to the two different sheets it copies the formula as opposed to the value rendering the 2 targets sheets useless.

How can I just copy the values as opposed to the formulas. Was looking for a Rows().Copyvalue function but that doesn't seem to exist. Any ideas?

Michael M · Jul 29, 2020

VBA Code:

Sub MM1()
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
For r = lr To 2 Step -1
    If Range("E" & 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
    with Sheets("As-Of-Trades").Range("A" & lr2 + 1) 
        .value=.value
    end with   
End If
Next r
End Sub

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

cwdamron

New Member

crater

New Member

Excel Facts

Blaise

New Member

Blaise

New Member

Blaise

New Member

ptjimmons

New Member

mjwatson

New Member

salemnj1

Board Regular

Frank_I

New Member

tfmeier

New Member

Michael M

Well-known Member

Similar threads

Forum statistics

Share this page

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

New Member

New Member

Excel Facts

New Member

New Member

New Member

New Member

New Member

Board Regular

New Member

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock