Macro que copie solo filas rellenas de una hoja a una nueva, para todo un libro

Hola buenos días:

La cuestión es la siguiente: tengo un libro con varias hojas(reportes) las cuales tienen filas coloreadas, ahora bien, estoy trabajando con una macro que hace este proceso: copia solo las filas coloreadas en una hoja nueva, pero hoja por hoja, y mi libro tiene mas de 30 hojas! Entonces es un rollo estar de una en una, por ello necesito que se ejecute esta macro para cada hoja, y de ser posible que la hoja nueva tenga el mismo nombre que la hoja origen(de donde se sacaron las filas coloreadas), anexo la macro y ojala me puedan ayudar u orientar, se los agradecería bastante, pues siempre se me ha complicado realizar una macro que se ejecute para todo el libro :( sin importar el número de hojas.

Sub copiafilarellena()
Set h1 = Sheets("Contraloria")
Set h2 = Sheets.Add
h1.Select
ini = "A"
fin = "O"
For i = 2 To h1.Range(ini & Rows.Count).End(xlUp).Row
si = 0
For j = 1 To Range(fin & 1).Column
Cells(i, j).Select
If Cells(i, j).Interior.ColorIndex = 6 Or Cells(i, j).Interior.ColorIndex = 27 Then
si = 1
Else
si = 0
End If
Next
If si = 1 Then
Range(ini & i & ":" & fin & i).Select
h1.Range(ini & i & ":" & fin & i).Copy h2.Range(ini & h2.Range(ini & Rows.Count).End(xlUp).Row + 1)
Selection.Delete Shift:=xlUp
i = i - 1
End If
Next
End Sub