Loop thru sheets copy and then paste in other sheet

[LuisE]

I’m 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 don’t know how to deal with both.

I don’t 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=Worksheets("Aging").Range("F65536").Row Then
LastRowAging = 2
Else
LastRowAging =
Worksheets("Aging").Range("A1").SpecialCells(xlLastCell).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

 

[Jim Thomlinson]

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

 

[ward376]

Look at Ron DeBruin's site - he has lots of good code for stuff like
this.

http://www.rondebruin.nl/copy2.htm

Cliff Edwards