Macro for copying specific rows from various worksheets to summary

[rsmith]

Hi there

I'm using excel 2003 and have a file with around 30 worksheets for which I
am trying to figure out how to get specific rows in specific worksheets to
summarise on a separate worksheet.

Bascially I'm trying to get the macro to look at 7 of the worksheets, and
then to look at Column C in these worksheets (from row 4 downwards). If the
cell is nonblank I would like the entire row from column A to column W to be
copied to a summary page called "Reports". I'm also trying to input the
worksheet name into the summary page for each specific row as well so that it
is easy to see which worksheet the row has come from.

Any help would be greatly appreciated. This is the first time I have asked a
question on here, but this site has helped me immensley over the years with
figureing out things in excel.

Again thanks in advance
rsmith

 

[Joel]

I added the sheet names to column A of the Report sheet. Change the array
ShtNames to include the 7 sheets you want to make the report from


Sub MakeReport()

Set ReportSht = Sheets("Report")
ShtNames = Array("Sheet1", "Sheet5", "Sheet10")

NewRow = 1
For Each sht In ShtNames
With Sheets(sht)
LastRow = .Range("C" & Rows.Count).End(xlUp).Row
For RowCount = 4 To LastRow
If .Range("C" & RowCount) <> "" Then
ReportSht.Range("A" & NewRow) = sht
.Range("A" & RowCount & ":W" & RowCount).Copy _
Destination:=ReportSht.Range("B" & RowCount)
NewRow = NewRow + 1
End If
Next RowCount
End With
Next sht

End Sub

 

[Joel]

I had a small typo. Use this code

Sub MakeReport()

Set ReportSht = Sheets("Report")
ShtNames = Array("Sheet1", "Sheet5", "Sheet10")

NewRow = 1
For Each sht In ShtNames
With Sheets(sht)
LastRow = .Range("C" & Rows.Count).End(xlUp).Row
For RowCount = 4 To LastRow
If .Range("C" & RowCount) <> "" Then
ReportSht.Range("A" & NewRow) = sht
.Range("A" & RowCount & ":W" & RowCount).Copy _
Destination:=ReportSht.Range("B" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
Next sht

End Sub

 

[JLatham]

Joel,
He's got 30 or more sheets to work with. Might it not be easier to write it
to go through all sheets in the workbook and deal with each UNLESS the sheet
is the summary sheet? Of course that assumes that all sheets except the one
summary sheet are to be processed.

Perhaps something like:

ub MakeReport()
Dim ReportSht As Worksheet
Dim anySheet As Worksheet

Set ReportSht = ThisWorkbook.Worksheets("Report")
NewRow = 1
For Each anySheet In ThisWorkbook.Worksheets
If anySheet.Name <> ReportSht.Name Then
With anySheet
LastRow = .Range("C" & Rows.Count).End(xlUp).Row
For RowCount = 4 To LastRow
If .Range("C" & RowCount) <> "" Then
ReportSht.Range("A" & NewRow) = sht
.Range("A" & RowCount & ":W" & RowCount).Copy _
Destination:=ReportSht.Range("B" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
End If
Next

End Sub

 

[Joel]

Read the posting again

"look at 7 of the worksheets"

 

[JLatham]

Oops! My bad. Somehow I missed that.

Read the posting again

"look at 7 of the worksheets"

 

[rsmith]

Thank you so much Joel - it works brilliantly!

I had a small typo. Use this code

Sub MakeReport()

Set ReportSht = Sheets("Report")
ShtNames = Array("Sheet1", "Sheet5", "Sheet10")

NewRow = 1
For Each sht In ShtNames
With Sheets(sht)
LastRow = .Range("C" & Rows.Count).End(xlUp).Row
For RowCount = 4 To LastRow
If .Range("C" & RowCount) <> "" Then
ReportSht.Range("A" & NewRow) = sht
.Range("A" & RowCount & ":W" & RowCount).Copy _
Destination:=ReportSht.Range("B" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
Next sht

End Sub