Tengo una macro que me crea una que me guarda la hoja en una carpeta en mi escritorio que yo crea antes, pero necesito que

Pero necesito que las carpetas "PEDIDOS LAMA" Y "HISTORIAL CLIENTES LAMA" se creen solas en el escritorio y si ya están creadas que no se dupliquen que use la que ya esta.

Tengo excel 2007

Dejo la macro que tengo para que me ayuden que tendría que cambiar por favor.

'Por. Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
ruta = "C:\Users\pablo\Desktop\PEDIDOS LAMA\"
'ruta = "C:\trabajo\"
carp = "pedidos " & Format(Date, "dd-mm-yyyy")
nomb = h1.[G7] & " " & Format(h1.[F4], "dd-mm-yyyy-hhmmss")
'
rut2 = ruta & carp
If Dir(rut2, vbDirectory) = "" Then
MkDir rut2
End If
'
h1.Copy
Set l2 = ActiveWorkbook
l2.SaveAs Filename:=rut2 & "\" & nomb & ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'l2.SaveAs rut2 & "\" & nomb & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
l2.Close
' guardar en carpetas pedidos clientes
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
ruta = "C:\Users\Pablo\Desktop\HISTORIAL CLIENTES LAMA\"
'ruta = "C:\trabajo\"
carp = "pedidos " & [G7]
nomb = h1.[G7] & " " & Format(h1.[F4], "dd-mm-yyyy-hhmmss") & "-" & [I3]
'
rut2 = ruta & carp
If Dir(rut2, vbDirectory) = "" Then
MkDir rut2
End If
'
h1.Copy
Set l2 = ActiveWorkbook
l2.SaveAs Filename:=rut2 & "\" & nomb & ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'l2.SaveAs rut2 & "\" & nomb & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
l2.Close

'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    ruta = "C:\Users\pablo\Desktop\PEDIDOS LAMA\"
    'ruta = "C:\trabajo\"
    carp = "pedidos " & Format(Date, "dd-mm-yyyy")
    nomb = h1.[G7] & " " & Format(h1.[F4], "dd-mm-yyyy-hhmmss")
    '
    rut2 = ruta & carp
    If Dir(rut2, vbDirectory) = "" Then
        MkDir rut2
    End If
    '
    h1.Copy
    Set l2 = ActiveWorkbook
    l2.SaveAs Filename:=rut2 & "\" & nomb & ".xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    'l2.SaveAs rut2 & "\" & nomb & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    l2.Close
    ' guardar en carpetas pedidos clientes
     Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    ruta = "C:\Users\Pablo\Desktop\HISTORIAL CLIENTES LAMA\"
    'ruta = "C:\trabajo\"
    carp = "pedidos " & [G7]
    nomb = h1.[G7] & " " & Format(h1.[F4], "dd-mm-yyyy-hhmmss") & "-" & [I3]
    '
    rut2 = ruta & carp
    If Dir(rut2, vbDirectory) = "" Then
        MkDir rut2
    End If
    '
    h1.Copy
    Set l2 = ActiveWorkbook
    l2.SaveAs Filename:=rut2 & "\" & nomb & ".xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    'l2.SaveAs rut2 & "\" & nomb & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    l2.Close

Añade tu respuesta

Haz clic para o