Copy rows across sheets
Assuming your data is:
1) in a big block (no gaps)
2) starts at row 18 column 1
3) has at least 2 bits of data on each page (the end(xldown) will not find
the end of the data otherwise)
then the following should do the trick
Sub copyEighteen()
Dim sht As Worksheet
Dim rng As Range
With Worksheets("Summary")
For Each sht In ThisWorkbook.Worksheets
'Process all but the summary sheet
If Not sht.Name = "Summary" Then
If Not IsEmpty(sht.Cells(18, 1)) Then
Set rng = Range(sht.Cells(18, 1), sht.Cells(18,
1).End(xlDown).End(xlToRight))
Range(.Cells(60000, 1).End(xlUp).Offset(1, 0),
..Cells(60000, 1).End(xlUp).Offset(rng.Rows.Count, rng.Columns.Count -
1)).Value = rng.Value
End If
End If
Next
End With
End Sub
|