Macro copiar datos

Hola Christian, que tal!, otra vez "molestándote" con dudas. Te comento, he intentado sin éxito hacer una macro que copie a un archivo receptor un rango con datos de un número variable de hojas de un archivo original.
Comentarte que si para cada hoja nueva del archivo original, escribo manualmente la siguiente rutina y cambiando el nombre de la hoja, la macro corre!
Sheets("080317 - Cartutxos impressora").Select
    ufh = Range("B" & Cells.Rows.Count).End(xlUp).Row + 1
    Range("B12:G" & ufh).Copy
    Windows(ficmacro).Activate
    Sheets("Hoja2").Select
    uf1 = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
    Range("A" & uf1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Hoja2").Range("A1").Select
La duda es poder conseguir una macro que recorra todas las hojas del archivo original, excepto hoja1 y hoja3, que copie los datos, y que estos aparezcan en el archivo receptor. Tal como te decía antes si escribo manualmente para cada hoja nueva del archivo original la rutina de arriba, cambiando solamente el nombre de la hoja, la macro corre, pero me parece muy tedioso...
Para ser más explícito te añado el código que estoy utilizando, donde:
RE-VS08.02_Control de residus.xls sería el archivo original, donde están cada una de las hojas
ficmacro es donde tengo la macro, que asigno a un botón.
Sub importar_dades()
Application.ScreenUpdating = False
    ruta = ActiveWorkbook.Path
    ficmacro = ActiveWorkbook.Name
    ficdatos = "RE-VS08.02_Control de residus.xls"
    Workbooks.Open Filename:=ruta & "\" & ficdatos
    Windows(ficmacro).Activate
    uf1 = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
    Sheets("Hoja2").Range("A7:E" & uf1).ClearContents
Sheets("080317 - Cartutxos impressora").Select
    ufh = Range("B" & Cells.Rows.Count).End(xlUp).Row + 1
    Range("B12:G" & ufh).Copy
    Windows(ficmacro).Activate
    Sheets("Hoja2").Select
    uf1 = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
    Range("A" & uf1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Hoja2").Range("A1").Select
Sheets("150110 - Envasos subst. Peril.").Select....................
..........
 Application.ScreenUpdating = True
    Windows(ficdatos).Close (1)
End Sub
Llevo días tratando de dar con la solución, utilizando la instrucción For Each... Next, y la macro no corre, por este motivo recurro a ti, esperando haber sido lo más explícito posible con la consulta...
Una vez más Christian, gracias por tu ayuda y tiempo!
Saludos