Set ws1 = ActiveSheet: Set ws2 = Worksheets(ws1.Index + 1)

Option Explicit

Sub Copy()
     Dim i As Long, ws1 As Worksheet, ws2 As Worksheet
     On Error GoTo Err_Execute
     'Start at A1
     Application.ScreenUpdating = False

     Set ws2 = Worksheets.Add(after:=Worksheets(Sheets.Count))
     For Each ws1 In Worksheets
         If ws1.Index <> Sheets.Count Then
             For i = 1 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
                 If ws1.Range("A" & i).Interior.Color = 65535 Then    'you said yellow in your example
                     ws1.Range("A" & i).EntireRow.Copy
                     ws2.Range("A" & ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                    False, Transpose:=False
                 End If
             Next
         End If
     Next

     ws2.Range("A1") = "Results"
     Application.ScreenUpdating = True
     MsgBox "The data has been successfully copied."
     On Error GoTo 0
     Exit Sub
Err_Execute:
     MsgBox "An error occurred. Error number " & Err.Number & " - " & Err.Description
End Sub