Completar la funcionalidad de está macro
Tengo esta macro:
Sub CREARCARPETAOFERTA()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Ruta = Range("J1")
arch = Sheets("DATOS ").Range("I1")
If Dir(Ruta & "\" & arch, vbDirectory) = "" Then
MkDir Ruta & "\" & arch
ActiveWorkbook.SaveAs Filename:=Ruta & "\" & arch & "\" & Sheets("DATOS ").Range("I2")
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub
Funciona muy bien. El problema es que, si ya existe la carpeta con el nombre que le he dado en la celda "I1" no hace nada, y necesito que me guarde dentro el archivo con el nuevo nombre de archivo que hay en la celda "I2".
1 respuesta
Creo que alcanza con poner el "SaveAs" fuera del If, quedaría algo así (validalo)
Sub CREARCARPETAOFERTA()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Ruta = Range("J1")
arch = Sheets("DATOS ").Range("I1")
If Dir(Ruta & "\" & arch, vbDirectory) = "" Then
MkDir Ruta & "\" & arch
End If
ActiveWorkbook.SaveAs Filename:=Ruta & "\" & arch & "\" & Sheets("DATOS ").Range("I2")
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End SubSalu2
Hola,
Creo que no me has puesto la macro modificada, está igual que la mía.
Saludos
No está igual... fijate las siguientes líneas
If Dir(Ruta & "\" & arch, vbDirectory) = "" Then
MkDir Ruta & "\" & arch
End If
ActiveWorkbook.SaveAs Filename:=Ruta & "\" & arch & "\" & Sheets("DATOS ").Range("I2")En tu caso el SaveAs está dentro del If
Salu2
Disculpa, tienes razón.
Funciona perfecto.
Perfecto!
Salu2