ExcelBanter - Loop thru sheets copy and then paste in other sheet

If it was me I would do it like this... It copies everything from sheet1, 2
and 3 to sheet aging.

Sub CopyStuff() 'Call me to execute
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
Select Case wks.Name
Case "Sheet1", "Sheet2", "Sheet3" 'change as needed
Call CopySheet(wks)
End Select
Next wks
End Sub

Public Sub CopySheet(wks As Worksheet)
Dim rngPaste As Range
Dim rngCopy As Range

With Sheets("Aging")
Set rngPaste = Cells(LastCell(Sheets("Aging")).Row + 1, "A")
End With
Set rngCopy = wks.Range(wks.Range("A1"), LastCell(wks))

rngCopy.Copy Destination:=rngPaste
End Sub

Public Function LastCell(Optional ByVal wks As Worksheet) As Range
Dim lngLastRow As Long
Dim intLastColumn As Integer

If wks Is Nothing Then Set wks = ActiveSheet
On Error Resume Next
lngLastRow = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
intLastColumn = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
If lngLastRow = 0 Then
lngLastRow = 1
intLastColumn = 1
End If
Set LastCell = wks.Cells(lngLastRow, intLastColumn)

End Function
--
HTH...

Jim Thomlinson

"LuisE" wrote:

Im want to loop thru sheet 1 to 5 and the copy €œA1:F last cell€
Then go to the €œAging€ tab and paste from in next empty row in column F.

I planning in using it also with Excel 2007 which will change the last
possible cell to 1,024,xxx but I dont know how to deal with both.

I dont have any problem copying the range from the looping sheets but when
it comes to paste it it overlaps. Here is what I have but it is not working.

If
Worksheets("Aging").Range("F1").End(xlDown).Row=Wo rksheets("Aging").Range("F65536").Row Then
LastRowAging = 2
Else
LastRowAging =
Worksheets("Aging").Range("A1").SpecialCells(xlLas tCell).Row
End If

Worksheets("Aging").Activate
Worksheets("Aging").Cells(LastRowAging, 1).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

End if

Thanks in advance