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

C

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

[TABLE="class: grid, width: 500, align: left"]
<TBODY>[TR]
[TD="align: center"]Fund[/TD]
[TD="align: center"]Account[/TD]
[TD="align: center"]Amount[/TD]
[TD="align: center"]Gain/Loss[/TD]
[TD="align: center"]As/Of? (Y/N)[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]11111[/TD]
[TD]$15000.00[/TD]
[TD]-$1.51[/TD]
[TD]YES[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]22222[/TD]
[TD]$32158.52[/TD]
[TD]$78.14[/TD]
[TD]YES[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]123123[/TD]
[TD]$1.00[/TD]
[TD]$0.00[/TD]
[TD]NO[/TD]
[/TR]
</TBODY>[/TABLE]
 
Sort by date Sort by votes
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:

[table="width: 800, class: grid, align: center"]
[tr]
[td][/td]
[td]A[/td]
[td]B[/td]
[td]C[/td]
[td]D[/td]
[td]E[/td]
[td]F[/td]
[td]G[/td]
[td]H[/td]
[td]I[/td]
[/tr]
[tr]
[td]2[/td]
[td]Checked In[/td]
[td]Last Name[/td]
[td]First Name[/td]
[td]Title[/td]
[td]Phone[/td]
[td]Report[/td]
[td]Depart[/td]
[td]Location[/td]
[td]Remarks[/td]
[/tr]
[tr]
[td]3[/td]
[td]X[/td]
[td]Smith[/td]
[td]John[/td]
[td]Asst[/td]
[td]123-456-7890[/td]
[td]5/18/2016[/td]
[td]5/18/2018[/td]
[td]Here[/td]
[td]Hire[/td]
[/tr]
[tr]
[td]4[/td]
[td]X[/td]
[td]Jones[/td]
[td]Jacob[/td]
[td]Mgr[/td]
[td]234-567-8901[/td]
[td]4/18/2016[/td]
[td]4/18/2018[/td]
[td]There[/td]
[td]Term[/td]
[/tr]
[tr]
[td]5[/td]
[td]X[/td]
[td]Schmidt[/td]
[td]Jingleheimer[/td]
[td]Dep[/td]
[td]345-678-9012[/td]
[td]3/18/2016[/td]
[td]3/18/2018[/td]
[td]Dunno[/td]
[td]End[/td]
[/tr]
[/table]

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.
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
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
Click to expand...

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
 
Upvote 0
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
 
Upvote 0
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
Click to expand...


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
 
Upvote 0
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!
 
Upvote 0
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
Click to expand...


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
 
Last edited by a moderator:
Upvote 0
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
Click to expand...

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?
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
cut/copy and paste row based on cell value not being equal to specific text
Replies
6
Views
495
mlan1604
M
N
  • Question Question
Finding the differences then copy and paste code to a new sheet
Replies
1
Views
624
myall_blues
myall_blues
M
  • Question Question
How can I copy entire row to another sheet based on cell value
Replies
1
Views
282
My Aswer Is This
My Aswer Is This
P
  • Question Question
Moving rows to different sheets based on drop down.
2
Replies
12
Views
988
purevega
P
S
  • Solved
VBA Copy and Paste to different sheets based on conditions
Replies
1
Views
534
HighAndWilder
H

Forum statistics

Threads
1,223,912
Messages
6,175,348
Members
452,638
Latest member
Oluwabukunmi

Share this page

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