Macro to Reorganize Data

[Korbrm]

Good Afternoon everyone,

I am working to have attached sheet1 look like attached sheet2. The code I currently have is below. Please bear with me as I am not used to doing anything with excel macros, I am a Crystal Report Dev.

I am looking to have the numbers pull over also.

The code I have....half *** thrown together: (any tips or suggestions would be greatly appreciated)

Sub ifail()

    Application.ScreenUpdating = False
    
 Sheets("Sheet1").Select
         Last = Cells(Rows.Count, "B").End(xlUp).Row
    For i = Last To 1 Step -1
        If (Cells(i, "B").Value) <> "Action Type" And (Cells(i, "B").Value) <> "EventsCompleted" And (Cells(i, "B").Value) <> "ProcessClosed" And (Cells(i, "B").Value) <> "ReprojectionsCreated" And (Cells(i, "B").Value) <> "HoldsEnded" Then
        Cells(i, "A").EntireRow.Delete
        End If
    Next i
    
    
    
    Sheets("Sheet2").Select
    Range("A3").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Employee"
    Range("B3").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Events Completed"
    Range("C3").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Process Closed"
    Range("D3").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Reprojections"
    Range("E3").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Holds Created"
    Range("F3").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Tasks Completed"
    
    Sheets("Sheet2").Select
    Range("A4").Select
    
    Sheets("Sheet1").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    
    Do Until IsEmpty(ActiveCell)
        Sheets("Sheet1").Select
        Selection.Copy
        Sheets("Sheet2").Select
        ActiveSheet.Paste
        Selection.Offset(1, 0).Select
        Sheets("Sheet1").Select
        Selection.End(xlDown).Select
    Loop
    

    
    Cells.Select
    Cells.EntireColumn.AutoFit
    
Application.ScreenUpdating = True
End Sub