Hi

See how this goes.

Sub bbb()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("Changes")
  Application.ScreenUpdating = False
  For Each ce In Range("AE2:AE" & Cells(Rows.Count, "AE").End(xlUp).Row)
    If Not IsError(ce) Then
      If ce.Value = 1 Then
      Application.StatusBar = ce.Row
      outrow = OutSH.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row
      Cells(ce.Row, 1).Resize(1, 31).Copy
      OutSH.Cells(outrow, 1).PasteSpecial (xlPasteValuesAndNumberFormats)
      
      End If
    End If
  
  
  Next ce
  
  Application.ScreenUpdating = True
  Application.CutCopyMode = False
  Application.StatusBar = False
End Sub
rylo