copying top 15 rows

hi all,

i have an issue with copying 15 rows (per sheet) of data from three different sheet.

The reason is because each of the three sheets is filtered using auto filter and so row 1, 3 5 whatever may not be visible. so icant just copy a pre set range.

i have found lots of vba script on copying row 1 to 15 but i cant get it to work.

so basically i want to have a summary sheet which grabs the top 15 results in sheets 1 2 and 3 and pastes the data automatcially into the sheet called summary.

i had something like
Sub CopyRows()
Sheets("30 Days").Select
' Find the last row of data
FinalRow = Range("A65536").End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column H
Sheets("30 Days").Select
Range("A" & x & ":I" & x).Copy
Sheets("Summary").Select
ActiveSheet.Paste



Next x
End Sub

but it doesn't work.

it just flickers for ages then stops and has copied nothing. i know its wrong but i aint really good at this.

would apprecaite any help

Cheers

Joel

There are a few methods for copying & pasting rows without pasting hidden/filtered out rows. The code below should do want you want.

You will have to insert the names of the worksheets that contain the rows to be copied where highlighted in green (separated by commas).

I've assumed that the worksheets have the first row as headers/field names and are therefore not to be copied. Also, I've assumed the data starts at row 1 column A.

If for some reason the filtered list is less than 15 rows, the code will only copy the number of visible rows.

Sub CopyFilteredRowsFromNamedSheets()
Dim rng As Range, intCount As Integer, rngArea As Range, rngRow As Range, wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
Select Case wks.Name
Case "Sheet1", "Sheet2" ' add other sheet names as required
Set rng = Intersect(wks.Range("A1").SpecialCells(xlCellTypeVisible), wks.Range("A1").CurrentRegion)
intCount = 0
For Each rngArea In rng.Areas
For Each rngRow In rngArea.Rows
If rngRow.Row > 1 Then ' ignores 1st row assuming this contains headers
rngRow.Copy
Worksheets("Summary").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
intCount = intCount + 1
End If
If intCount = 15 Then GoTo ExitLoop
Next rngRow
Next rngArea
ExitLoop:
Application.CutCopyMode = False
End Select
Next wks
End Sub

hi loz,

thanks heaps for that - i'll give it a try!

Cheers

Joel

it seems to work - but because of the formula that is in the sheet2, it copies the formula and that stuffs it up.

how do you make it just copy the actual value not forumla? i belive it will work perfect then.

thanks again loz

Joel

hey,

just for references for future people all i need was

Worksheets("Summary").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial xlValues

xlValues - added to end of line.

worked fine.

thanks again loz

Joel