rows of data moved from one sheet to another by VBA

flyfisher

Board Regular
Joined
Jul 23, 2002
Messages
56
I am trying move rows of data that don't match a criteria on site from one sheet to another. As the sheets are many I need to do this by code as the criteria changes for each sheet.
In the case below I need to move the entire row where Site = #N/A
I have tried the following but it will not work (I have left out where the site data is passed from for brevity):

Sub MoveText
dim cell as object

Range([D2],[D2].end(xldown)).select
For Each cell in Selection
If cell<> 1300 Or cell<> 1400 Then
cell.entirerow.cut
sheets("MixedCase").select
[A1].end(xldown).Offset(1,0).paste pastespecial:=xlvalues
sheets("Raws").select
end if
next cell
end sub
Book1
ABCDEFGHIJ
1ItemLogCodeAbbCodeSite200208200209200210200211200212200213
25997059970WNA14000008008500
3582459980WNB14000800800000
42422160570OTW#N/A0500500500500500
5582559960WNC#N/A080080000800
62422089970OBW1300012001200120001200
Raws


I hope Colo's code displays as all I can see is HTML.

cheers

Flyfisher
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

DonkeyOte

MrExcel MVP
Joined
Sep 6, 2002
Messages
9,123
Flyfisher for a start I would amend your code slightly...

Change : Range([D2],[D2].end(xldown)).select
to something like..
DATA = Sheets("RAWS").Range("D2:D100") (where 100 is the last row - I hate using xlDown etc...did you record this macro?)
For Each RDATA in DATA...

Now, the data you want moved...is that to be moved to the same line as currently in RAWS or should it be in the next blank row on that sheet? Assuming it should be in the same row...

I would add a little code - before the For Each - I would add .. CROW = 2 (where 2 is the first line of data in Col D)

Then before NEXT RDATA I would have CROW = CROW + 1

So...to clear things up I would use the following

Sub MoveText
dim cell as object

DATA = Sheets("RAWS").Range("D2:D100")
CROW = 2

For Each RDATA in DATA

If RDATA<> 1300 Or RDATA<> 1400 Then

Rows(CROW & ":" & CROW).Select
Selection.Cut
Sheets("MixedCase").select
Range("A" & CROW).PasteSpecial xlPasteValues
sheets("Raws").select

end if

CROW = CROW + 1

next cell

end sub









On 2002-10-12 23:50, flyfisher wrote:
I am trying move rows of data that don't match a criteria on site from one sheet to another. As the sheets are many I need to do this by code as the criteria changes for each sheet.
In the case below I need to move the entire row where Site = #N/A
I have tried the following but it will not work (I have left out where the site data is passed from for brevity):

Sub MoveText
dim cell as object

Range([D2],[D2].end(xldown)).select
For Each cell in Selection
If cell<> 1300 Or cell<> 1400 Then
cell.entirerow.cut
sheets("MixedCase").select
[A1].end(xldown).Offset(1,0).paste pastespecial:=xlvalues
sheets("Raws").select
end if
next cell
end sub
Book1
ABCDEFGHIJ
1ItemLogCodeAbbCodeSite200208200209200210200211200212200213
25997059970WNA14000008008500
3582459980WNB14000800800000
42422160570OTW#N/A0500500500500500
5582559960WNC#N/A080080000800
62422089970OBW1300012001200120001200
Raws


I hope Colo's code displays as all I can see is HTML.

cheers

Flyfisher
 

DonkeyOte

MrExcel MVP
Joined
Sep 6, 2002
Messages
9,123
jsut realised that won't work...(because you're cutting the row - therefore CROW will be a problem in terms of pasting etc...

You could copy the row and then clear the contents of the row on Sheet RAWS. Then at the end of the macro sort RAWS by some criteria that would then move the blanks to the bottom.

Rows(CROW & ":" & CROW).Select
Selection.Copy
Sheets("MixedCase").select
Range("A" & CROW).PasteSpecial xlPasteValues
sheets("Raws").select
Rows(CROW & ":" & CROW).ClearContents
 

flyfisher

Board Regular
Joined
Jul 23, 2002
Messages
56
Thanks LSAW10
The reason I am using xldown is that their are 18 sheets I have to do this for and each is different - from 50 rows to 400+. I suppose just as easily I could use [A65536].end(xlUp) to nominate the range. This report is for a multi site manufacturing environment that does a Review Of Business at least 4 times a year and this report uses to take three people three days to collate data from different systems now (when) I complete this project it will take 45 mins by one person to collate the data.
Checking out the code now - thanks. I had a mental blank as to how I was to move this data.
cheers
flyfisher
 

DonkeyOte

MrExcel MVP
Joined
Sep 6, 2002
Messages
9,123

ADVERTISEMENT

Well you could probably put in another for each next loop - re: the different sheets - each could then have a separate row identifier to ensure the data's being picked up and pasted ok.

Ambitious project...the best kind! Good luck...:wink:
 

Ivan F Moala

MrExcel MVP
Joined
Feb 10, 2002
Messages
4,209
You could speed things up by using
the Autofilter and filtering out the data
Then copying the data over.

eg.

<pre/>
Dim rTheRg As Range


Set rTheRg = Range(Range("A1:J1"), Range("A1:J1").End(xlDown))
With rTheRg
.AutoFilter
.AutoFilter Field:=4, Criteria1:=">0", Operator:=xlAnd
End With

</pre>
 

flyfisher

Board Regular
Joined
Jul 23, 2002
Messages
56
Thanks everyone. Sorry for the delay in replying (been dragged off to do another project). Keeps the wolves from the door and the bills paid.
Have tried both solutions and can now at least isolate the correct data but will need to do some work in shifting to the next sheet. At least you have got me over the mental hurdle I had. Once again thanks.

cheers
flyfisher
 

Forum statistics

Threads
1,147,451
Messages
5,741,188
Members
423,647
Latest member
lyanndominique

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
Top