Copy Cell into new sheet conditionaly

Hi Ryan,

I understand what you want to do now, but you didn't provide any details.

See if you can work with this code:

Sub test()
Dim ws As Worksheet
Dim lRow1 As Integer
Dim lRow2 As Integer

lRow1 = Range("A" & Rows.Count).End(xlUp).Row

For Each ws In Worksheets
If ws.Name = "Final tab" Then GoTo Nxt
For Each cell In Range("A1:A" & lRow1)
lRow2 = Sheets("Final tab").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
If cell.Value > 0 Then _
cell.EntireRow.Copy Destination:=Sheets("Final tab").Range("A" & lRow2)
Next cell
Nxt:
Next ws
End Sub

If you can't figure it out, then please provide me with the following information:
Which columns contains the # ordered (in the above code I used column A).
What is your final tab called (in the above code I used "Final tab").

Also consider the option to post your workbook using a filesharing site like www.speedyshare.com. If you do then make sure the file extention is .xls, since I'm still using Excel 2003.

Best regards,
Trowa

Thanks again Trowa, I have uploaded a test copy of my sheet. The link is

http://www.speedyshare.com/files/30951529/Test_Inventory.xls

I very much appreciate the help.

I thought I knew something about excel programs...guess I was wrong...lol

Hi Ryan,

I'm guessing that your "Substrate" sheet is one of your category sheets and that your "Order Sheet" is your final sheet in which you like the rows to be copied to.

If this is true then use this code:
Sub test()
Dim ws As Worksheet
Dim lRow1 As Integer
Dim lRow2 As Integer

lRow1 = Range("A" & Rows.Count).End(xlUp).Row

For Each ws In Worksheets
If ws.Name = "Order Sheet" Then GoTo Nxt
For Each cell In Range("D7:D" & lRow1)
lRow2 = Sheets("Order Sheet").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
If IsNumeric(cell.Value) And cell.Value > 0 Then _
cell.EntireRow.Copy Destination:=Sheets("Order Sheet").Range("A" & lRow2)
Next cell
Nxt:
Next ws
End Sub

Just to be complete here is your file with code:
https://authentification.site/files/31008161/Test_Inventory2.xls

Is this to your liking?

Best regards,
Trowa

Hi Ryan,

I thought Open Office didn't support VBA, but after some google searches I found that new versions should support VBA (I have no experience with OpenOffice).
I also found a site which converts Excel VBA to OpenOffice basic.

So what I understand is that OpenOffice does have VBA only a different kind of version (why make it easy right?!)

So I would first advise you to make sure you have the latest version.
Then try the code again or this converted code:

Sub test() 
Dim ws As Worksheet 
Dim lRow1 As Integer 
Dim lRow2 As Integer 

lRow1 = Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)("A" & Rows.Count).End(xlUp).Row 

For Each ws In ThisComponent.Sheets.getByName() 
If ws.Name = "Order Sheet" Then GoTo Nxt 
For Each cell In Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)("D7:D" & lRow1) 
lRow2 = Sheets("Order Sheet").Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)("A" & Rows.Count).End(xlUp).Offset(1, 0).Row 
If IsNumeric(cell.Value) And cell.Value > 0 Then _ 
cell.EntireRow.Copy Destination:=Sheets("Order Sheet").Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)("A" & lRow2) 
Next cell 
Nxt: 
Next ws 
End Sub 

This is the site I used for converting the code:
https://www.business-spreadsheets.com/vba2oo.asp

Hopefully you can make the code work for you.

Please keep me posted, so I know what the possibilities are with OpenOffice.

Thanks and best regards,
Trowa

Hi Ryan,

Good to see you got rid of OpenOffice.

Using your example file "Test inventory" I don't encounter a row being copied three times.

Could you upload another sample where that occurs so I can check it out?

Thanks and Regards,
Trowa

Hi Trowa,

The problem may lie in the fact that I use a multiple sheet system. I actually have 6 Sheets including my final "order sheet" I can upload a new sheet, unless, you can add a few identical sheets to the test copy.

Thanks,

Ryan

Hi Ryan,

The numbers of sheets don't matter.
The code will loop through any sheets except for "Order sheet" and copies the row with a value higher then 0 in column D.

Do you mean you don't want duplicates?

Best regards,
Trowa

Yes,

I believe that is what I mean.

I am getting duplicate results on the main page, and it is not going through the sheets. It is like it is looping through the one page.

Sometimes it copies it 3 times, and sometimes 4. It is also dependant on which sheet I hit the macro on.

Thank you so much for the support.

What I meant by duplicates is that you might have the same row of data on multiple sheets, thus getting duplicates on your main page.

This is not happening with you, from what I understand.

I would really like to run the code on the file you are using to see what is going on.

Could you upload your file?

Best regards,
Trowa