cut and paste rows with criteria to other sheets [SOLVED]

[looney]

Hi I am trying to split up data. I need to cut and paste rows from the sheet DUMP to 2 other sheets.

In column AR the rows are marked with Inbound, Outbound or E-mail. I need the rows with Outbound and E-mail in the sheets Outbound and Email. But they have to paste rows in the next empty row.


I found some VBA coding which I tried to modify a bit, but it seems there is nothing happening... SO who can help me out.


this is the code:


[pre]<br />
Sub emailoutbound()</p>
<p> 'Determine destination sheetname<br />
If AR = "Outbound" Then ShtName = "Outbound"<br />
If AR = "E-mail" Then ShtName = "Email"</p>
<p> 'Find it's last used row<br />
LastRowUsed = Sheets(SntName).UsedRange.Rows.Count</p>
<p> 'Copy current row to next empty row on destination sheet<br />
Rows(R).Select<br />
Selection.Cut<br />
Sheets(ShtName).Select<br />
Rows(LastRowUsed + 1).Select<br />
ActiveSheet.Paste</p>
<p> 'Return to my sheet and go to next row<br />
Sheets("DUMP&#34.Activate<br />
R = R + 1</p>
<p>End Sub<br />
[/pre]

 

[Hui]

Have you had a look at this post:

http://chandoo.org/wp/2012/05/14/vba-move-data-from-one-sheet-to-multiple-sheets/

 

[looney]

Thanks Hui,


tried the example file. It seems to be almost doing what I need. Although I am not sure about what I try to do is right. As I want to cut the rows and paste it on the other sheets. I get an error at: "Selection.PasteSpecial xlPasteValues" when I try to change the line with "Selection.Copy" to "Selection.Cut". I am not even sure if this is possible.


Now writing this... I am thinking I might should try a different approach on the issue. As this piece of code will go trough all the rows and I need an other criteria "Inbound" to stay untouched. I hope this will not be slow at a large chunk of data. I'll play around a bit more with it, but another suggestion would be welcome too.

 

[SirJB7]

Hi, looney!

Consider uploading a sample file (including manual examples of desired output if applicable), it'd be very useful for those who read this and might be able to help you. Thank you. Give a look at the green sticky posts at this forums main page for uploading guidelines.

Regards!

 

[looney]

I tried to modify the example from the post from Hui. But got stuck after the first copied row.


I created an example file:


https://www.dropbox.com/s/6loixt0kbf7nbkq/samplerows.xls


Thanks SirJB7 for taking a look.

 

[SirJB7]

Hi, looney!


Try placing this code in a new module (so as to safely use Option Explicit clause without changing your existing code) and running it:

-----

[pre]

Option Explicit

Sub TryThis()
' constants
Const ksSourceWS = "DUMP"
Const kiColumn = 44
Const ksTarget1 = "Inbound"
Const ksTarget2 = "Outbound"
Const ksTarget3 = "E-mail"
' declarations
Dim I As Long, J As Long, J1 As Long, J2 As Long, J3 As Long, A As String
' start
I = 2
J1 = 1
J2 = 1
J3 = 1
' process
With Worksheets(ksSourceWS)
Do Until .Cells(I, kiColumn).Value = ""
A = .Cells(I, kiColumn).Value
If A = ksTarget1 Or A = ksTarget2 Or A = ksTarget3 Then
If A = ksTarget1 Then J1 = J1 + 1: J = J1
If A = ksTarget2 Then J2 = J2 + 1: J = J2
If A = ksTarget3 Then J3 = J3 + 1: J = J3
.Rows(I).Copy Worksheets(A).Cells(J, 1)
End If
I = I + 1
Loop
End With
' end
Beep
End Sub

[/pre]
-----


Just advise if any issue.


Regards!

 

[looney]

Wow... at first I thought nothing is happening... But SirJB7. You just amazed me with this stunning piece of art. It works so quick that it is even more then perfect. this is exactly what I need.


BIG THANKS!!!

 

[SirJB7]

Hi, looney!

Glad you solved it. Thanks for your feedback and for your kind words too. And welcome back whenever needed or wanted.

Regards!

PS: That's why I placed a Beep, just to advise you it has finished