Preciso otimizar uma rotina na Macro do Excel

[ArthurS]

Prezados,

Criei um macro porem ela está muito repetitiva.

Tenho um arquivo com uma planilha padrões, e preciso colar a mesma para diversas outras planilhas na mesma pasta.

Segue um pequeno pedaço para esboçar o que estou falando.

 

Sub Macro1()

 

    Cells.Select

    Selection.Copy

    Workbooks.Open Filename:= _

        "Z:\Projetos\Em andamento\FIBRIA\SEGUNDA ETAPA DE INSPEÇÃO\CHECKLIST\relatorio\3024-01-71-G-10555.xlsx"

    Sheets("2ª Etapa de inspeção").Select

    Cells.Select

    ActiveSheet.Paste

    Range("A3").Select

    Application.CutCopyMode = False

    ActiveCell.FormulaR1C1 = "='1ª Etapa de inspeção'!RC"

    ActiveWorkbook.Save

    ActiveWindow.Close

    Cells.Select

    Selection.Copy

    Workbooks.Open Filename:= _

        "Z:\Projetos\Em andamento\FIBRIA\SEGUNDA ETAPA DE INSPEÇÃO\CHECKLIST\relatorio\3024-01-71-G-10556.xlsx"

    Sheets("2ª Etapa de inspeção").Select

    Cells.Select

    ActiveSheet.Paste

    Range("A3").Select

    Application.CutCopyMode = False

    ActiveCell.FormulaR1C1 = "='1ª Etapa de inspeção'!RC"

    ActiveWorkbook.Save

    ActiveWindow.Close

    Cells.Select

    Selection.Copy

    Workbooks.Open Filename:= _

        "Z:\Projetos\Em andamento\FIBRIA\SEGUNDA ETAPA DE INSPEÇÃO\CHECKLIST\relatorio\3024-01-71-G-10557.xlsx"

    Sheets("2ª Etapa de inspeção").Select

    Cells.Select

    ActiveSheet.Paste

    Range("A3").Select

    Application.CutCopyMode = False

    ActiveCell.FormulaR1C1 = "='1ª Etapa de inspeção'!RC"

    ActiveWorkbook.Save

    ActiveWindow.Close

    Cells.Select

    Selection.Copy

    Workbooks.Open Filename:= _

        "Z:\Projetos\Em andamento\FIBRIA\SEGUNDA ETAPA DE INSPEÇÃO\CHECKLIST\relatorio\3024-01-71-G-10558.xlsx"

    Sheets("2ª Etapa de inspeção").Select

    Cells.Select

    ActiveSheet.Paste

    Range("A3").Select

    Application.CutCopyMode = False

    ActiveCell.FormulaR1C1 = "='1ª Etapa de inspeção'!RC"

    ActiveWorkbook.Save

    ActiveWindow.Close

 

.

.

.

End Sub

 

Obrigado!