PDA

View Full Version : Copying data from multiple sheets to one - feedback Req.



Simon Lloyd
01-16-2007, 03:02 AM
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?


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
Regards,
SImon

Charlize
01-16-2007, 04:18 AM
Dim rng as Range
Are you using rng ?
Dim i as Variant
Why not Long ? If it's just a number that you need ?

Charlize
01-16-2007, 05:25 AM
Use of the sheetscollection (or something like that) to go through the sheets (when we add some sheets later, it will still work).
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
Charlize

Simon Lloyd
01-16-2007, 06:03 AM
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
01-16-2007, 12:13 PM
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
01-16-2007, 03:04 PM
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