Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract and copy Rows where value is Greater than 0 (zero)
Hello All,
I am using Office 2003/Windows XP and have a workbook with many sheets (50+). I wish to extract the rows from all the sheets in Column G, where the value is equal to 1 or greater than 1. Following is the sample sheet.. Data is not consistent.. I wish to copy the complete row to a New Worksheet one below other from Sheet1 to the end 50+ sheets. A B C D E F G H 1 Data Data Data 0 Data 2 Data Data 1 3 blank row 4 blank row 5 Data Data 0 6 Data 2 Data .... .... ..... Last Data is in Row No. 65 Is this possible thru VBA. Any help would be greatly appreciated. Thanks in advance Ashish Kumar |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract and copy Rows where value is Greater than 0 (zero)
Sub CopyData()
Dim sh as Worksheet Dim sh1 as Worksheet Dim i as long, rng as Range Application.DisplayAlerts = False On Error Resume Next worksheets("Summary").Delete On Error goto 0 Application.DisplayAlerts = True set sh = worksheets.Add(after:=worksheets(worksheets.count) ) sh.Name = "Summary" for each sh1 in Worksheets if sh1.Name < sh.Name then lastrow = sh1.cells(rows.count,7).End(xlup).row for i = 2 to lastrow if isnumeric(sh1.Cells(i,"G").Value) then if sh1.cells(i,"G").Value = 1 then set rng = sh.cells(rows.count,7).End(xlup)(2,-5) sh1.Cells(i,"G").EntireRow.copy Destination:=rng end if end if Next End if Next End Sub -- Regards, Tom Ogilvy wrote in message oups.com... Hello All, I am using Office 2003/Windows XP and have a workbook with many sheets (50+). I wish to extract the rows from all the sheets in Column G, where the value is equal to 1 or greater than 1. Following is the sample sheet.. Data is not consistent.. I wish to copy the complete row to a New Worksheet one below other from Sheet1 to the end 50+ sheets. A B C D E F G H 1 Data Data Data 0 Data 2 Data Data 1 3 blank row 4 blank row 5 Data Data 0 6 Data 2 Data ... ... .... Last Data is in Row No. 65 Is this possible thru VBA. Any help would be greatly appreciated. Thanks in advance Ashish Kumar |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract and copy Rows where value is Greater than 0 (zero)
WOW...Thanks Tom.
It works like a charm....but I am stumped with another problem...Is it possible to have the respective sheet names in Column A and data from the rows in Column B?.. Can you help please? Thanks once again for your time and support. Ashish Kumar |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract and copy Rows where value is Greater than 0 (zero)
Sub CopyData()
Dim sh as Worksheet Dim sh1 as Worksheet Dim i as long, rng as Range Dim col as Long Application.DisplayAlerts = False On Error Resume Next worksheets("Summary").Delete On Error goto 0 Application.DisplayAlerts = True set sh = worksheets.Add(after:=worksheets(worksheets.count) ) sh.Name = "Summary" for each sh1 in Worksheets if sh1.Name < sh.Name then lastrow = sh1.cells(rows.count,7).End(xlup).row for i = 2 to lastrow if isnumeric(sh1.Cells(i,"G").Value) then if sh1.cells(i,"G").Value = 1 then set rng = sh.cells(rows.count,8).End(xlup)(2,-6) rng.Value = sh1.Name col = sh1.Cells(i,"IV4").End(xltoLeft) sh1.Range(sh1.Cells(i,"G"), _ sh1.Cells(i,col)).copy Destination:=rng(1,2) end if end if Next End if Next End Sub -- Regards, Tom Ogilvy "prkhan56" wrote in message oups.com... WOW...Thanks Tom. It works like a charm....but I am stumped with another problem...Is it possible to have the respective sheet names in Column A and data from the rows in Column B?.. Can you help please? Thanks once again for your time and support. Ashish Kumar |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract and copy Rows where value is Greater than 0 (zero)
Tom
It gives the following error Runtime error 1004 Application defined or object defined error and highlights the following.. col = sh1.Cells(i,"IV4").End(xltoLef¬t) Did I miss something? Thanks once again for your time and help Ashish Kumar Tom Ogilvy wrote: Sub CopyData() Dim sh as Worksheet Dim sh1 as Worksheet Dim i as long, rng as Range Dim col as Long Application.DisplayAlerts = False On Error Resume Next worksheets("Summary").Delete On Error goto 0 Application.DisplayAlerts = True set sh = worksheets.Add(after:=worksheets(worksheets.count) ) sh.Name = "Summary" for each sh1 in Worksheets if sh1.Name < sh.Name then lastrow = sh1.cells(rows.count,7).End(xlup).row for i = 2 to lastrow if isnumeric(sh1.Cells(i,"G").Value) then if sh1.cells(i,"G").Value = 1 then set rng = sh.cells(rows.count,8).End(xlup)(2,-6) rng.Value = sh1.Name col = sh1.Cells(i,"IV4").End(xltoLeft) sh1.Range(sh1.Cells(i,"G"), _ sh1.Cells(i,col)).copy Destination:=rng(1,2) end if end if Next End if Next End Sub -- Regards, Tom Ogilvy "prkhan56" wrote in message oups.com... WOW...Thanks Tom. It works like a charm....but I am stumped with another problem...Is it possible to have the respective sheet names in Column A and data from the rows in Column B?.. Can you help please? Thanks once again for your time and support. Ashish Kumar |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Conditional format lowest value greater than zero and copy formula | Excel Discussion (Misc queries) | |||
Auto extract data & inserts rows additional rows automatically | Excel Discussion (Misc queries) | |||
how do i filter a list greater than 1000 rows | Excel Discussion (Misc queries) | |||
Copy rows if greater than zero | Excel Worksheet Functions | |||
Charting when number of rows are greater than 65536 | Charts and Charting in Excel |