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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract and copy Rows where value is Greater than 0 (zero)
Thanks Dave.. but the code is not having any symbol between "f" and "t"
in xltoleft... I checked it again on my system...the symbol appeared while I copied the code from my system... there is no symbol between "f" and "t".. Can u guess what is wrong then? Ashish Kumar |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract and copy Rows where value is Greater than 0 (zero)
Try this:
col = sh1.Cells(i, "IV").End(xlToLeft).Column And you may want to add one more declaration: Dim LastRow as long (Right at the top with the others.) wrote: Thanks Dave.. but the code is not having any symbol between "f" and "t" in xltoleft... I checked it again on my system...the symbol appeared while I copied the code from my system... there is no symbol between "f" and "t".. Can u guess what is wrong then? Ashish Kumar -- Dave Peterson |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract and copy Rows where value is Greater than 0 (zero)
Hi Dave,
I tried your suggestion.. it does not give the desired result.. it copies everything from all the sheets to Row No.2 in the Summary Sheet and keeps on over writing on the same row until the last sheet in the workbook... so what remains on Summary Sheet is the detail from the last sheet. Is this clear to you. Thanks for your time Ashish Kumar |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract and copy Rows where value is Greater than 0 (zero)
You wanted the whole row copied from the original worksheets?
Option Explicit Sub CopyData() Dim sh As Worksheet Dim sh1 As Worksheet Dim i As Long, rng As Range Dim LastRow As Long 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, 1).End(xlUp)(2) rng.Value = sh1.Name col = sh1.Cells(i, "IV").End(xlToLeft).Column sh1.Range(sh1.Cells(i, "A"), _ sh1.Cells(i, col)).Copy Destination:=rng(1, 2) End If End If Next End If Next End Sub Tom's second code had this line: sh1.Range(sh1.Cells(i, "G"), _ sh1.Cells(i, col)).Copy Destination:=rng(1, 2) I changed it to column A: sh1.Range(sh1.Cells(i, "A"), _ sh1.Cells(i, col)).Copy Destination:=rng(1, 2) Tom's code copied from column G to the right. If you wanted that, change the code back. wrote: Hi Dave, I tried your suggestion.. it does not give the desired result.. it copies everything from all the sheets to Row No.2 in the Summary Sheet and keeps on over writing on the same row until the last sheet in the workbook... so what remains on Summary Sheet is the detail from the last sheet. Is this clear to you. Thanks for your time Ashish Kumar -- Dave Peterson |
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 |