Macro Excel que seleccione y copie solo una hoja

H o l a:

Te anexo la macro para que la pongas en un libro, guarda el libro en otra carpeta diferente a donde tienes los 40 libros.

Sub CopiarUnaHoja()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.SheetsInNewWorkbook = 1
    '
    ruta = "C:\Producción\"     'Carpeta
    hoja = "Produción IRI"      'Nombre de la hoja a copiar
    '
    Set l2 = Workbooks.Add
    arch = Dir(ruta & "*xls*")
    Do While arch <> ""
        Set l3 = Workbooks.Open(ruta & arch)
        existe = False
        For Each h In l3.Sheets
            If UCase(h.Name) = UCase(hoja) Then
                existe = True
                Exit For
            End If
        Next
        If existe Then
            nuevo = l3.Sheets(hoja).[O3]
            If nuevo = "" Then nuevo = arch
            h.Copy after:=l2.Sheets(l2.Sheets.Count)
            l2.Sheets(l2.Sheets.Count).Name = nuevo
        End If
        l3.Close False
        arch = Dir()
    Loop
    l2.Sheets(1).Delete
    Application.ScreenUpdating = True
    l2.Activate
    MsgBox "Copia terminada", vbInformation, "COPIAR UNA HOJA"
End Sub

Si es necesario, actualiza en la macro los datos de carpeta y hoja a copiar en estas líneas:

ruta = "C:\Producción\" 'Carpeta
hoja = "Produción IRI" 'Nombre de la hoja a copiar

Dante amor, muchas gracias por tu aporte pero me da un erro en la línea

l2.Sheets(1).Delete

El libro debe contener al menos una hoja visible.

Para eliminar u ocultar la hoja u hojas seleccionadas primero debe insertar una hoja nueva o mostrar alguna hoja oculta.

Los libros no los abre, genera un libro nuevo y creo que es por eso. En cuanto a la ruta esta bien y los ficheros tienen todos 3 o más hojas.

Al dar ese erro se salta toda esta parte:

Do While arch <> ""
        Set l3 = Workbooks.Open(ruta & arch)
        existe = False
        For Each h In l3.Sheets
            If UCase(h.Name) = UCase(hoja) Then
                existe = True
                Exit For
            End If
        Next
        If existe Then
            nuevo = l3.Sheets(hoja).[O3]
            If nuevo = "" Then nuevo = arch
            h.Copy after:=l2.Sheets(l2.Sheets.Count)
            l2.Sheets(l2.Sheets.Count).Name = nuevo
        End If
        l3.Close False
        arch = Dir()
    Loop

Muchas gracias por tu ayuda.