Solved: Extract Data from multi worksheets

[James Niven]

I have various tabs of a worksheet with data all are the same number of columns but different number of rows. I wish to extract from each worksheet the entire row to a summary sheet based on the cell value in column B if it equals the number zero.

I then want to delete that row in each of the tabs where the zero in column B resides.

I have an attachment with sample data.
I found sample code from one of the posts, it works fine for on sheet and but does not move to the next sheet.

Thanks

James

[Benzadeus]

[VBA]Sub ExtractRows()
Dim i As Long 'increment for rows in the report sheet.
Dim n As Long 'for loop through each sheet's row values.
Dim rLast As Long
Dim sht As Worksheet
Dim shtReport As Worksheet

Const rHeaderOffset As Long = 2 'this is the row where your data begins.
Const cValues As String = "B" 'this is the column where we have the values.

Set shtReport = Sheets.Add
shtReport.Name = "Report" 'just to make things make sense.

i = 2 'this is the row where the first found 0 row value will be inserted
'in the report sheet.

For Each sht In Sheets
With sht
If sht.Name <> shtReport.Name Then
rLast = .Cells(.Rows.Count, cValues).End(xlUp).Row
For n = rHeaderOffset To rLast
If .Cells(n, cValues) = 0 And WorksheetFunction.CountA(.Rows(n)) > 0 Then
.Rows(n).EntireRow.Copy Destination:=shtReport.Rows(i)
i = i + 1
End If
Next n
End If
End With
Next sht
Set shtReport = Nothing
End Sub[/VBA]

[James Niven]

Hi Benzadeus,

Thanks for the quick reply and your code works very well.

I still require the second part of my question as outlined below:

Once to Zero rows have been copied over, I wish to delete each zero row from each of the tabs where the zero in column B resides.

Thanks

James

[mdmackillop]

Try this variation. The copied order will be reversed though.
[VBA]
For Each sht In Sheets
With sht
If sht.Name <> shtReport.Name Then
rLast = .Cells(.Rows.Count, cValues).End(xlUp).Row
For n = rLast To rHeaderOffset Step -1
If .Cells(n, cValues) = 0 And WorksheetFunction.CountA(.Rows(n)) > 0 Then
.Rows(n).EntireRow.Copy Destination:=shtReport.Rows(i)
.Rows(n).Delete
i = i + 1
End If
Next n
End If
End With
Next sht
[/VBA]

[Benzadeus]

Hi Benzadeus,

Thanks for the quick reply and your code works very well.

I still require the second part of my question as outlined below:

Once to Zero rows have been copied over, I wish to delete each zero row from each of the tabs where the zero in column B resides.

Thanks

James

I misunderstood, sorry. Use MD's code.

[James Niven]

Benzadeus/mdmackillop,

I appreciate both of your code lines.

Benzadeus, no problem at all, you steered me in the right direction.

mdmackillop, thanks this worked fantastic!!!

Thanks to both of you!!

This is avery good site to gain knowledge and get help!