Visual Basic para Aplicaciones - Corrección de macro para crear y copiar hoja a determinada carpeta

Life is soft - evento anual de software empresarial
   
Vista:
Imágen de perfil de JoaoM

Corrección de macro para crear y copiar hoja a determinada carpeta

Publicado por JoaoM (39 intervenciones) el 12/10/2015 18:34:57
Hola amigos
Tengo esta macro la cual crea carpeta y sub carpeta pero:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub CreaCarpetas()
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
 
    MkDir "C:\trabajo" ' SI YA EXISTE LA CARPETA, MANDA ERROR
 
    ruta = "C:\trabajo\"
    año = Format(Date, "YYYY")
    mes = Format(Date, "mmmm-YYYY")
    On Error Resume Next
    MkDir ruta & "\" & año
    MkDir ruta & "\" & año & "\" & mes
    On Error GoTo 0
    '
    ruta = ruta & año & "\" & mes & "\"
 
    arch = "Parte.xlsx" 'Aqui el auto-nombre de hoja HOJA.NAME\.XLSX
    Sheets("Parte").Copy 'AQUI EL AUTONOMBRE DE HOJA HOJA.NAME
 
    ActiveWorkbook.SaveAs Filename:=ruta & arch, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
 
    Application.ScreenUpdating = True
        Application.DisplayAlerts = True
 
    MsgBox "Hoja copiada"
End Sub
1º Si la carpeta C:\trabajo ya existe, manda error en esa linea

2º Quiero que para copiar la hoja, no tenga el nombre especifico de la hoja si no que busque nombre de hoja, Sheets.name, (WorkSheet.name (creo)) es decir, si la hoja no es la misma a copiar, tendria que a cada momento cambiar su nombre en la macro

3º Que la ruta sea una sola, es decir, que ruta haga referencia a

1
ruta = "C:\trabajo" & format(Date, "yyyy") & format(Date, "mmmm-yyyy")

las 3 en una sola linea. Trate de hacerlo pero siempre manda error

Gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Corrección de macro para crear y copiar hoja a determinada carpeta

Publicado por Rafael (11 intervenciones) el 13/10/2015 12:12:07
A ver 1, 2, 3:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub CreaCarpetas()
    Dim ruta As String
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
 
    ruta = "C:\Trabajo" & Format(Date, "YYYY-mmmm-YYYY")  ' Aqui montas la ruta o directorio  (Punto 3)
                                                          'no entiendo por que pones dos veces el año pero lo dejamos asi 
                                                          'ya que has puesto ruta = "C:\trabajo" & format(Date, "yyyy") & format(Date, "mmmm-yyyy")
    If Dir(ruta, vbDirectory) = "" Then   'Aqui validas si existe o no el directorio (Punto 1)
        MkDir ruta
    End If
 
    arch = Application.ActiveSheet.Name & ".xlsx"  'Aqui pones el Nombre de la Hoja Activa... 
                                                   'He de suponer que es lo quisiste decir en el punto 2 pero mis dotes de adivino a veces fallan. 
    Application.ActiveSheet.Copy
 
    ActiveWorkbook.SaveAs Filename:=ruta & "\" & arch, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Hoja copiada"
End Sub

Si te sirve un mas uno no me viene mal...

Saludos
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
Imágen de perfil de JoaoM

Corrección de macro para crear y copiar hoja a determinada carpeta

Publicado por JoaoM (39 intervenciones) el 13/10/2015 21:07:59
Hola Rafael, gracias por responder y tomar tu tiempo.
Yo l oque pretendo es que me de chnce de escojer cual ruta quiero con la ventana de Guardar como:

El nombre se lo doy en la macro con la variable nbr = Aqui le doy yo el nombre uque debe llevar el archivo
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de JoaoM

Corrección de macro para crear y copiar hoja a determinada carpeta

Publicado por JoaoM (39 intervenciones) el 13/10/2015 23:33:40
Puse porque ya no sabia mas que hacer con mis minimos conocimientos por eso puse para que alguien tuviera alguna idea que me solcionara esto

Como dije arriba
El nombre se lo doy en la macro con la variable nbr = Aqui le doy yo el nombre uque debe llevar el archivo
El directorio será así = C:\ trabajo \ 2015 \ Outubre 2015 \ Parte.xlsx y no solo C:\Trabajo2015-octubre-2015

Por eso la creacion de C:\trabajo luego la creacion de C:\trabajo \ 2015 \ Outubre 2015
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de JoaoM

Corrección de macro para crear y copiar hoja a determinada carpeta

Publicado por JoaoM (39 intervenciones) el 14/10/2015 00:30:50
Me la pude componer así pero me sigue mencionando que el directorio ya esta creado y no sigue.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub CreaCarpetas()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
 
    MkDir "C:\trabajo" ' SI YA EXISTE LA CARPETA, MANDA ERROR
 
    ruta1 = "C:\trabajo\"
    año = Format(Date, "YYYY")
    mes = Format(Date, "mmmm-YYYY")
 
    On Error Resume Next
 
    MkDir ruta1 & "\" & año
    MkDir ruta1 & "\" & año & "\" & mes
 
    On Error GoTo 0
 
    ruta = ruta1 & año & "\" & mes & "\"
 
        If Dir(ruta, vbDirectory) = "" Then   'Aqui validas si existe o no el directorio (Punto 1)
            MkDir ruta
        End If
 
    arch = Application.ActiveSheet.Name & ".xlsx"  'Aqui pones el Nombre de la Hoja Activa...
    Application.ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=ruta & arch, FileFormat:=xlOpenXMLWorkbook
 
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
    MsgBox "Hoja copiada"
 
End Sub

Me sigue marcando la linea MkDir "C:\trabajo" ' SI YA EXISTE LA CARPETA, MANDA ERROR
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Royeth

Corrección de macro para crear y copiar hoja a determinada carpeta

Publicado por Royeth jesus.royeth@gmail.com (9 intervenciones) el 14/10/2015 00:45:15
para la opción guardar como puedes hacer

1
fName = Application.GetSaveAsFilename

lo que pasa es que no te he entendido muy bien qué deseas hacer para poder ayudarte pero bueno ahí te dejo el código para que te deje buscar la opción donde lo vas a guardar un saludo
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de JoaoM

Corrección de macro para crear y copiar hoja a determinada carpeta

Publicado por JoaoM (39 intervenciones) el 14/10/2015 01:02:09
Hola Royeth, Gracias por tu interes
En resumen:

1º Que la macro me copie la hoja activa con el nombre de la pestaña respectiva (no siempre es la misma por lo tanto creo que se usa Application.ActiveSheet.Name & ".xlsx")

2º la ruta la creará la macro pero si ya existe dicha ruta, que pase adelante SIN ERROR

3º La ruta será esta C:\Trabajo \ 2015 \ Outubre \ Nombre de hoja.xlsx
tiene que captar el año y mes que corre (actual del sistema) cuando se ejecute la macro
8xm2pg
La cosa del mes es dejando solo mes = Format(Date, "mmmm")
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar