Copying data from multiple sheets to one - feedback Req.

[Simon Lloyd]

Hi all i have answered a post where the Ops asked for data from 8 sheets to be copied to a summary sheet, the criteria was that if there was data in coulmn A then copy that and the offset(0,1) to a sheet called summary, there is no other data in the summary sheet - So this is the solution i posted - Could you give feedback or criticisms please?

[VBA]
Sub sortandmove()
Dim Rng As Range
Dim i As Variant
For i = 1 To 8
Application.ScreenUpdating = False
With Sheets(i)
Columns("A:A").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
Selection.EntireRow.Copy Destination:=Sheets("Summary").Range("A65536").End(xlUp)(2)
End With
Next i
With Sheets(i)
Application.CutCopyMode = False
Selection.AutoFilter
End With
Application.ScreenUpdating = True
End Sub
[/VBA]Regards,
SImon

[Charlize]

[VBA]Dim rng as Range[/VBA]
Are you using rng ?
[VBA]Dim i as Variant[/VBA]
Why not Long ? If it's just a number that you need ?

[Charlize]

Use of the sheetscollection (or something like that) to go through the sheets (when we add some sheets later, it will still work).
[vba]Sub sortandmove()
'declare sht
Dim sht As Worksheet
'last row in the sht sheets
Dim lrow As Long
'destination row of summary
Dim dest_lrow As Long
'for each sht in the sheets of the workbook
For Each sht In ActiveWorkbook.Worksheets
'compare the sheetname with this
If sht.Name <> "Summary" Then
'activate sheet (necessary ???)
sht.Activate
lrow = sht.Range("A" & Rows.Count).End(xlUp).Row
dest_lrow = Worksheets("Summary").Range("A" & Rows.Count).End(xlUp).Row
Range("A1").AutoFilter Field:=1, Criteria1:="<>"
'copy column A and B from the cells that are visible
Range("A2:B" & lrow).SpecialCells(xlCellTypeVisible).Copy _
'tell where to paste the data that you've just put in memory
Worksheets("Summary").Range ("A" & dest_lrow + 1)
'remove autofilter
Selection.AutoFilter
End If
'next sheet
Next sht
'select this sheet
Worksheets("Summary").Select
End Sub[/vba]
Charlize

[Simon Lloyd]

Charlize, thanks for the reply, i used Rng originally when i was working on the solution and didnt remove it!, I also thought that if using a letter to represent an object it would have to be declared as variant - but in this case what difference would it make to use either Variant or Long?

Thanks for your worked solution, i agree that it is very useful to have a self expanding range for the sheets.

Regards,
Simon

[Norie]

Simon

You aren't actually referencing the worksheets in the With End With.

And are you sue only the filtered rows are being copied?

Also i will be 9 at the end of the loop.

Are there 9 worksheets?

Sub sortandmove()
Dim Rng As Range
Dim i As Variant

    Application.ScreenUpdating = False
    For i = 1 To 8
        
        With Sheets(i).Columns("A:A")
            .AutoFilter
            .AutoFilter Field:=1, Criteria1:="<>"
            .EntireRow.Copy Destination:=Sheets("Summary").Range("A65536").End(xlUp)(2)
        End With
    Next i
    Application.ScreenUpdating = True
    
End Sub

[Simon Lloyd]

Norie thanks for your reply - there are as i understand 9 sheets the 9th being the summary sheet, isn't Sheets(i) referencing the worksheet?, and no i am not sure that only the filtered rows are being copied, but when i used some test data it moved exactly as need because the Ops asked for the code to look for data in column A if there is then copy that and the adjoining cell in column B and paste to the summary sheet, they required that it works through all 8 sheets adding the data to the summary sheet - the code as i posted it seemed to do the trick!

Regards,
Simon