This should be a bit more efficient. Run from anywhere in the workbook
Option Explicit
Sub copytosummary()
Dim dlr, slr, slc As Long
Dim ws As Worksheet
For Each ws In Worksheets
dlr = Sheets("summary"). _
Cells(Rows.Count, 1).End(xlUp).Row + 1
If ws.Name <> "Summary" Then
With ws
slr = .Cells(Rows.Count, "a").End(xlUp).Row
slc = .Cells(slr, "a").End(xlToRight).Column
.Cells(2, 1).Resize(slr, slc).Copy _
Sheets("Summary").Cells(dlr, 1)
End With
End If
Next ws
End Sub
--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(E-Mail Removed)
"J.W. Aldridge" <(E-Mail Removed)> wrote in message
news:f6b7b1fa-a565-49e5-9261-(E-Mail Removed)...
> Sub Consolidate1()
>
> Application.ScreenUpdating = False
>
> Sheets("apples").Select
>
> Range("a2").Select
>
> Range(Selection, Selection.End(xlDown)).Select
>
> Range(Selection, Selection.End(xlToRight)).Select
>
>
> Selection.Copy
>
> Sheets("Summary").Select
>
> Range("A65536").End(xlUp).Select
>
>
> ActiveCell.Offset(1, 0).Select
>
> Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
> SkipBlanks:= _
> False, Transpose:=False
> Application.Goto Selection.Cells(1)
>
> End Sub
>
> _______________________________
> Sub Consolidate2()
>
> Application.ScreenUpdating = False
>
> Sheets("cherries").Select
>
> Range("a2").Select
>
> Range(Selection, Selection.End(xlDown)).Select
>
> Range(Selection, Selection.End(xlToRight)).Select
>
>
> Selection.Copy
>
> Sheets("Summary").Select
>
> Range("A65536").End(xlUp).Select
>
>
> ActiveCell.Offset(1, 0).Select
>
> Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
> SkipBlanks:= _
> False, Transpose:=False
> Application.Goto Selection.Cells(1)
>
> End Sub
> ____________________________
> Sub Consolidate3()
>
> Application.ScreenUpdating = False
>
> Sheets("grapes").Select
>
> Range("a2").Select
>
> Range(Selection, Selection.End(xlDown)).Select
>
> Range(Selection, Selection.End(xlToRight)).Select
>
>
> Selection.Copy
>
> Sheets("Summary").Select
>
> Range("A65536").End(xlUp).Select
>
> ActiveCell.Offset(1, 0).Select
>
> Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
> SkipBlanks:= _
> False, Transpose:=False
> Application.Goto Selection.Cells(1)
>
> End Sub