Slow Do While Loop

Hi,

I have the code below to look at one sheet, and depending on the results, copy the relevant row to the relevant tab. It takes around a minute to run on my PC (checking 1000 rows), and was wondering if there was any way to optimise it? :-

Do
    Select Case ActiveCell.Text
        Case "KWH"
            LastCol1 = Range("IV3").End(xlToLeft).Column
            CurrentRowPos = ActiveCell.Row
            CurrentColumnPos = ActiveCell.Column
            MyRange = Worksheets("Sheet1").Range(Cells(CurrentRowPos, CurrentColumnPos), Cells(CurrentRowPos, LastCol1))
            Results = WorksheetFunction.Sum(MyRange)
            sumkwh = Format(sumkwh + Results, "0.0")
            ActiveCell.EntireRow.Copy
            Sheets("KWH").Activate
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            ActiveCell.Offset(1, 0).Select
        Case "LEAD"
            LastCol1 = Range("IV3").End(xlToLeft).Column
            CurrentRowPos = ActiveCell.Row
            CurrentColumnPos = ActiveCell.Column
            MyRange = Worksheets("Sheet1").Range(Cells(CurrentRowPos, CurrentColumnPos), Cells(CurrentRowPos, LastCol1))
            Results = WorksheetFunction.Sum(MyRange)
            sumlead = Format(sumlead + Results, "0.0")
            ActiveCell.EntireRow.Copy
            Sheets("Temp").Activate
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            ActiveCell.Offset(1, 0).Select
        Case "LAG"
            LastCol1 = Range("IV3").End(xlToLeft).Column
            CurrentRowPos = ActiveCell.Row
            CurrentColumnPos = ActiveCell.Column
            MyRange = Worksheets("Sheet1").Range(Cells(CurrentRowPos, CurrentColumnPos), Cells(CurrentRowPos, LastCol1))
            Results = WorksheetFunction.Sum(MyRange)
            sumlag = Format(sumlag + Results, "0.0")
            ActiveCell.EntireRow.Copy
            Sheets("Temp").Activate
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            ActiveCell.Offset(1, 0).Select
    End Select
    Sheets("Sheet1").Activate
    ActiveCell.Offset(1, 0).Select
Loop While ActiveCell.Value <> Empty

I'd be glad of any ideas as I'm sure this can be done more quickly.

Thanks in advance!