Modificación de macro que guarda archivo

Primero, quita esta línea de tu código:

On Error Resume Next

No es recomendable utilizar esa instrucción, porque cualquier error siempre va a continuar y sabrás cuál es el problema.

Ahora prueba lo siguiente:

  Select Case UCase(Trim([N6]))
    Case "MINERD"
      ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA-22-23\CARPETA DE FACTURA MINERD-22-23\"
    Case "PRIVADO"
      ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA-22-23\CARPETA DE FACTURA PRIVADO-22-23\"
    Case Else
      ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA-23-24\"
  End Select
  ActiveWorkbook.SaveAs Filename:=ruta & num & ".xls", FileFormat:=xlNormal
  ActiveWorkbook.Close True

Revisa qué error te envía y comentas...

Te invito a SUSCRIBIRTE a mi canal para ver más sobre Excel y Macros:

(1) Tutoriales Excel y Macros - YouTube

sal u dos

Te invito a SUSCRIBIRTE a mi canal para ver más sobre Excel y Macros.

SUSCRIBIRTE

Saludos, Sr.Dante

Inserte la modificación hecha por ud., pero aun no me envía el archivo a (carpeta de factura-23-24)

Esta es la macro completa:

Public boton As Boolean
Sub Imprimir()
'Por.DAM - Corregido por Elsamatilde
If ActiveSheet.Name = "." Then
    Set h1 = ActiveSheet
    'EM: QUITAR PARA QUE MUESTRE MENSAJE DE ARCHIVO EXISTE
    'Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    boton = True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    num = Range("A9")
    ActiveSheet.Copy
    If ActiveSheet.ProtectContents Then
        ActiveSheet.Unprotect "maximo"
    End If
    h1.Range("E9").Copy
    Range("E9").PasteSpecial Paste:=xlValues
    ActiveSheet.Protect "maximo"
    'em: si se presenta mensaje pasa a la línea de cierre y allí se permite guardar con otro nombre
    Select Case UCase(Trim([N6]))
    Case "MINERD"
      ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA-22-23\CARPETA DE FACTURA MINERD-22-23\"
    Case "PRIVADO"
      ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA-22-23\CARPETA DE FACTURA PRIVADO-22-23\"
    Case Else
      ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA-23-24\"
  End Select
  ActiveWorkbook.SaveAs Filename:=ruta & num & ".xls", FileFormat:=xlNormal
  ActiveWorkbook.Close True
    'EM: SI SE CANCELA EL GUARDADO QUEDA COMO LIBRO ACTIVO y hay que forzar el cerrado.
    If Left(ActiveWorkbook.Name, 5) = "Libro" Then
        ActiveWorkbook.Close False
    End If
    ActiveSheet.Unprotect "maximo"
        Range("D5") = Range("D5") + 1
    ActiveSheet.Protect "maximo"
    'Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End If
boton = False
End Sub
Sub printprev()
'Por.dam
boton = True
ActiveWindow.SelectedSheets.PrintPreview
boton = False
End Sub

Ya me suscribí a su canal

Gra cias por la suscripción.

Ejecuta la macro paso a paso con F8 y dime hasta dónde llegas o si envía algún mensaje de error.

Buenos días Sr. Dante

Yo entro al modulo a ejecutar la macro y me guarda el archivo en la carpeta correspondiente según lo que ve en la celda (N6) (privado o minerd) y no presenta ningún error, el problema esta en la ultima carpeta ´´CArpeta de facutara-23-24¨¨ que es donde debe guardar el archivo sin tomar en cuenta la condición establecida en la celda (N6) y no lo esta guardando.

La ejecute con (F8) y cuando llega a las direcciones donde debe guardar, salta la carpeta (carpeta de factura-23-24).

MG

Qué tienes en la celda N6 al momento de la ejecución.

La condición que tú pusiste al igual que la que yo puse no es para ignorar la condición en N6. Va a guardar el archvo en esa carpeta solamente si en N6 es diferente a minerd y también si ed diferente a privado.

Entonces en N6 pon cualquier letra y prueba nuevamente con F8

El problema esta en la ultima carpeta ´´CArpeta de facutara-23-24¨¨ que es donde debe guardar el archivo sin tomar en cuenta la condición establecida en la celda (N6) y no lo esta guardando.

Si debe guardar el archivo siempre en la misma carpeta entonces quita las condiciones:

Sub Imprimir()
'Por.Dante Amor
  Dim h1 As Worksheet
  Dim num As String, ruta As String
  '
  If ActiveSheet.Name = "." Then
      Set h1 = ActiveSheet
      Application.ScreenUpdating = False
      boton = True
      h1.PrintOut Copies:=1, Collate:=True
      num = h1.Range("A9").Value
      h1.Copy
      If ActiveSheet.ProtectContents Then
        ActiveSheet.Unprotect "maximo"
      End If
      h1.Range("E9").Copy
      Range("E9").PasteSpecial Paste:=xlValues
      '
      ActiveSheet.Protect "maximo"
      ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA-23-24\"
      ActiveWorkbook.SaveAs Filename:=ruta & num & ".xls", FileFormat:=xlNormal
      ActiveWorkbook.Close False
      '
      h1.Unprotect "maximo"
      h1.Range("D5") = Range("D5") + 1
      h1.Protect "maximo"
    End If
    Application.ScreenUpdating = True
    boton = False
End Sub

Si quieres que se guarde en las 2 carpetas:

Sub Imprimir()
'Por.Dante Amor
  Dim h1 As Worksheet
  Dim num As String, ruta As String
  '
  If ActiveSheet.Name = "." Then
      Set h1 = ActiveSheet
      Application.ScreenUpdating = False
      boton = True
      h1.PrintOut Copies:=1, Collate:=True
      num = h1.Range("A9").Value
      h1.Copy
      If ActiveSheet.ProtectContents Then
        ActiveSheet.Unprotect "maximo"
      End If
      h1.Range("E9").Copy
      Range("E9").PasteSpecial Paste:=xlValues
      '
      Select Case UCase(Trim([N6]))
        Case "MINERD"
          ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA-22-23\CARPETA DE FACTURA MINERD-22-23\"
        Case "PRIVADO"
          ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA-22-23\CARPETA DE FACTURA PRIVADO-22-23\"
        Case Else
          ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA-23-24\"
      End Select
      '
      ActiveSheet.Protect "maximo"
      ActiveWorkbook.SaveAs Filename:=ruta & num & ".xls", FileFormat:=xlNormal
      '
      ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA-23-24\"
      ActiveWorkbook.SaveAs Filename:=ruta & num & ".xls", FileFormat:=xlNormal
      ActiveWorkbook.Close False
      '
      h1.Unprotect "maximo"
      h1.Range("D5") = Range("D5") + 1
      h1.Protect "maximo"
    End If
    Application.ScreenUpdating = True
    boton = False
End Sub

Excelente, gracias mil como siempre.

El tutorial sobre como enviar las notas a los estudiantes por correo es bastante útil y oportuno.

Voy hacerle promoción al mismo para otros colegios se beneficiendelmismo.

Saludos,

Máximo Gomez