this might be a little faster since it performs fewer individual instructions:

Sub FlashyMacro()

Screen Update = False

Dim Row1 As Double, Row2 As Double
Dim Row3 As Double, SheetOnScreen As String

Application.Calculation = xlManual

Row1 = 4
Row2 = 2
Row3 = 2

SheetOnScreen = ActiveCell.Worksheet.Name
If SheetOnScreen < "Sheet3" Then
SheetOnScreen = "Sheet2"
End If

Worksheets(SheetOnScreen).Activate
If (SheetOnScreen = "Sheet2") Then
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
Else
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select
End If

Worksheets("Sheet2").Cells(Row2, 1) _
.Resize(1,5).Clearcontents
Worksheets("Sheet3").Cells(Row3, 1) _
.Resize(1,5).Clearcontents



While Worksheets("Sheet1").Cells(Row1, 1) < ""
If Worksheets("Sheet1").Cells(Row1, 1) = "In" Then
If Worksheets("Sheet2").Cells(Row2, 1) = "" Then

Worksheets("Sheet2").Cells(Row2, 1).Value = _
Worksheets("Sheet1").Cells(Row1, 2)

Worksheets("Sheet2").Cells(Row2, 2) _
.Resize(1,4).Value = Worksheets("Sheet1") _
.Cells(Row1, 5).Resize(1,4).Value

Else

Worksheets("Sheet1").Cells(Row1,5) _
.Resize(1,4).copy

Worksheets("Sheet2").Cells(Row2, 3) _
.Resize(1,4).PasteSpecial xlValue, xlAdd

End If
End If
If Worksheets("Sheet1").Cells(Row1, 1) = "Out" Then
If Worksheets("Sheet3").Cells(Row3, 1) = "" Then

Worksheets("Sheet3").Cells(Row3, 1) = _
DateSerial(Year(Worksheets("Sheet1").Cells(Row1, 3)), _
Month(Worksheets("Sheet1").Cells(Row1, 3)), 1)

Worksheets("Sheet3").Cells(Row3, 2) _
.Resize(1,4).Value = Worksheets("Sheet1") _
.Cells(Row1, 5).Resize(1,4).Value

Else

Worksheets("Sheet1").Cells(row1,5) _
.Resize(1,4).copy

worksheets("Sheet3").Cells(ROW3,2) _
.Resize(1,4).pasteSpecial xlValues, xlAdd

End If
End If
Row1 = Row1 + 1
If Worksheets("Sheet1").Cells(Row1, 1) = "In" And _
Worksheets("Sheet2").Cells(Row2, 1) < _
Worksheets("Sheet1").Cells(Row1,2) Then
Row2 = Row2 + 1
If (SheetOnScreen = "Sheet2") Then
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
End If
Worksheets("Sheet2").Cells(Row2, 1) _
.Resize(1,5).clearContents
End If

If Worksheets("Sheet1").Cells(Row1, 1) = "Out" And _
Worksheets("Sheet3").Cells(Row3, 1) < "" And _
Month(Worksheets("Sheet3").Cells(Row3, 1)) < _
Month(Worksheets("Sheet1").Cells(Row1, 3)) Then
Row3 = Row3 + 1
If (SheetOnScreen = "Sheet3") Then
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select
End If
Worksheets("Sheet3").Cells(Row3, 1) _
.Resize(1,5).ClearContents
End If
Wend

Worksheets("Sheet1").Activate
Worksheets("Sheet1").Cells(Row1, 1).Select

Worksheets("Sheet3").Activate
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select

Worksheets("Sheet2").Activate
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select

Calculate
Application.Calculation = xlAutomatic

Worksheets(SheetOnScreen).Activate

End Sub

Without knowing more about your data, I would hesitate to do much more.
I don't see where the activating and selecting have anything to do with the
macro except maybe to give you visual feedback. If you don't need that
feedback, you might remove those lines.

--
Regards,
Tom Ogilvy


"HoogaBooger" wrote:


Thank you for your reply.

Sorry, it's all very unclear because I tried to shorten my post by
cutting the code, obviously in the wrong places.

The layout is indeed different in every worksheet.

Here's the code in its full glory:

Sub FlashyMacro()

Screen Update = False

Dim Row1 As Double, Row2 As Double, Row3 As Double, SheetOnScreen As
String

Application.Calculation = xlManual

Row1 = 4
Row2 = 2
Row3 = 2

SheetOnScreen = ActiveCell.Worksheet.Name
If SheetOnScreen < "Sheet3" Then
SheetOnScreen = "Sheet2"
End If

Worksheets(SheetOnScreen).Activate
If (SheetOnScreen = "Sheet2") Then
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
Else
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select
End If

Worksheets("Sheet2").Cells(Row2, 1) = ""
Worksheets("Sheet2").Cells(Row2, 2) = ""
Worksheets("Sheet2").Cells(Row2, 3) = ""
Worksheets("Sheet2").Cells(Row2, 4) = ""
Worksheets("Sheet2").Cells(Row2, 5) = ""
Worksheets("Sheet3").Cells(Row3, 1) = ""
Worksheets("Sheet3").Cells(Row3, 2) = ""
Worksheets("Sheet3").Cells(Row3, 3) = ""
Worksheets("Sheet3").Cells(Row3, 4) = ""
Worksheets("Sheet3").Cells(Row3, 5) = ""


While Worksheets("Sheet1").Cells(Row1, 1) < ""
If Worksheets("Sheet1").Cells(Row1, 1) = "In" Then
If Worksheets("Sheet2").Cells(Row2, 1) = "" Then
Worksheets("Sheet2").Cells(Row2, 1) =
Worksheets("Sheet1").Cells(Row1, 2)
Worksheets("Sheet2").Cells(Row2, 2) =
Worksheets("Sheet1").Cells(Row1, 5)
Worksheets("Sheet2").Cells(Row2, 3) =
Worksheets("Sheet1").Cells(Row1, 6)
Worksheets("Sheet2").Cells(Row2, 4) =
Worksheets("Sheet1").Cells(Row1, 7)
Worksheets("Sheet2").Cells(Row2, 5) =
Worksheets("Sheet1").Cells(Row1, 8)
Else
Worksheets("Sheet2").Cells(Row2, 2) =
Worksheets("Sheet2").Cells(Row2, 2) + Worksheets("Sheet1").Cells(Row1,
5)
Worksheets("Sheet2").Cells(Row2, 3) =
Worksheets("Sheet2").Cells(Row2, 3) + Worksheets("Sheet1").Cells(Row1,
6)
Worksheets("Sheet2").Cells(Row2, 4) =
Worksheets("Sheet2").Cells(Row2, 4) + Worksheets("Sheet1").Cells(Row1,
7)
Worksheets("Sheet2").Cells(Row2, 5) =
Worksheets("Sheet2").Cells(Row2, 5) + Worksheets("Sheet1").Cells(Row1,
8)
End If
End If
If Worksheets("Sheet1").Cells(Row1, 1) = "Out" Then
If Worksheets("Sheet3").Cells(Row3, 1) = "" Then
Worksheets("Sheet3").Cells(Row3, 1) =
DateSerial(Year(Worksheets("Sheet1").Cells(Row1, 3)),
Month(Worksheets("Sheet1").Cells(Row1, 3)), 1)
Worksheets("Sheet3").Cells(Row3, 2) =
Worksheets("Sheet1").Cells(Row1, 5)
Worksheets("Sheet3").Cells(Row3, 3) =
Worksheets("Sheet1").Cells(Row1, 6)
Worksheets("Sheet3").Cells(Row3, 4) =
Worksheets("Sheet1").Cells(Row1, 7)
Worksheets("Sheet3").Cells(Row3, 5) =
Worksheets("Sheet1").Cells(Row1, 8)
Else
Worksheets("Sheet3").Cells(Row3, 2) =
Worksheets("Sheet3").Cells(Row3, 2) + Worksheets("Sheet1").Cells(Row1,
5)
Worksheets("Sheet3").Cells(Row3, 3) =
Worksheets("Sheet3").Cells(Row3, 3) + Worksheets("Sheet1").Cells(Row1,
6)
Worksheets("Sheet3").Cells(Row3, 4) =
Worksheets("Sheet3").Cells(Row3, 4) + Worksheets("Sheet1").Cells(Row1,
7)
Worksheets("Sheet3").Cells(Row3, 5) =
Worksheets("Sheet3").Cells(Row3, 5) + Worksheets("Sheet1").Cells(Row1,
8)
End If
End If
Row1 = Row1 + 1
If Worksheets("Sheet1").Cells(Row1, 1) = "In" And
Worksheets("Sheet2").Cells(Row2, 1) < Worksheets("Sheet1").Cells(Row1,
2) Then
Row2 = Row2 + 1
If (SheetOnScreen = "Sheet2") Then
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
End If
Worksheets("Sheet2").Cells(Row2, 1) = ""
Worksheets("Sheet2").Cells(Row2, 2) = ""
Worksheets("Sheet2").Cells(Row2, 3) = ""
Worksheets("Sheet2").Cells(Row2, 4) = ""
Worksheets("Sheet2").Cells(Row2, 5) = ""
End If
If Worksheets("Sheet1").Cells(Row1, 1) = "Out" And
Worksheets("Sheet3").Cells(Row3, 1) < "" And
Month(Worksheets("Sheet3").Cells(Row3, 1)) <
Month(Worksheets("Sheet1").Cells(Row1, 3)) Then
Row3 = Row3 + 1
If (SheetOnScreen = "Sheet3") Then
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select
End If
Worksheets("Sheet3").Cells(Row3, 1) = ""
Worksheets("Sheet3").Cells(Row3, 2) = ""
Worksheets("Sheet3").Cells(Row3, 3) = ""
Worksheets("Sheet3").Cells(Row3, 4) = ""
Worksheets("Sheet3").Cells(Row3, 5) = ""
End If
Wend

Worksheets("Sheet1").Activate
Worksheets("Sheet1").Cells(Row1, 1).Select

Worksheets("Sheet3").Activate
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select

Worksheets("Sheet2").Activate
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select

Calculate
Application.Calculation = xlAutomatic

Worksheets(SheetOnScreen).Activate

End Sub


--
HoogaBooger
------------------------------------------------------------------------
HoogaBooger's Profile: http://www.excelforum.com/member.php...o&userid=34084
View this thread: http://www.excelforum.com/showthread...hreadid=538479