Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Generar archivos

Excel - Generar archivos

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil
Val: 4
Ha aumentado su posición en 2 puestos en Excel (en relación al último mes)
Gráfica de Excel

Generar archivos

Publicado por leoalvis (2 intervenciones) el 08/05/2018 05:20:43
Buenas noches; Resulta que quiero generar 5 archivos correspondientes a cinco asesores que manejan varios municipios. Es decir necesito generar los archivos de acuerdo a la columna "Asesor". Para los rangos los estoy nombrando via VBA. Lo extraño es que cuando intento ejecutar la macro me sale el error "1004 el rango de extraccion tiene un nombre inexistente o no valido". No logro ver por que me sale ese error si los nombres que he asignado coinciden con los del fljo del codigo. Adjunto el archivo xlsm. Agradezco la ayuda.
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
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Generar archivos

Publicado por Antoni Masana (2477 intervenciones) el 08/05/2018 10:50:27
Te pongo la macro modificada. Lo he realizado con AUTOFILTRO

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
35
36
37
38
39
40
41
42
43
44
45
46
47
Option Explicit
 
Sub breakMyList()
    Dim Tabla(5) As String, a As Byte, Desti As String, Fecha As String
 
    Tabla(1) = "ANA  MARIA CRUZ"
    Tabla(2) = "JENNY QUINTERO"
    Tabla(3) = "LILIANA  CELEMIN"
    Tabla(4) = "CARLOS  TRUJILLO"
    Tabla(5) = "NATHALIE OSPINA"
 
    Desti = ActiveWorkbook.Path & "\"
    Fecha = " " & Format(Now, "dmmmyyyy") & ".xlsx"
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    For a = 1 To 5
        Range("A1:H1").Select
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$H$114").AutoFilter _
                    Field:=5, _
                    Criteria1:=Tabla(a)
 
        Range("A1").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Range("A1:H114").Select
        Selection.Copy
 
        Workbooks.Add
        ActiveSheet.Paste
 
        Columns("A:H").Select
        Columns("A:H").EntireColumn.AutoFit
        Range("A1").Select
 
        ActiveWorkbook.SaveAs Filename:=Desti & Tabla(a) & Fecha, _
                              FileFormat:=xlOpenXMLWorkbook, _
                              CreateBackup:=False
        ActiveWorkbook.Close
    Next
 
    Selection.AutoFilter
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Range("A1").Select
End Sub

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
sin imagen de perfil
Val: 4
Ha aumentado su posición en 2 puestos en Excel (en relación al último mes)
Gráfica de Excel

Generar archivos

Publicado por leoalvis (2 intervenciones) el 10/05/2018 00:13:45
Excelente Antoni muchas gracias me sirvió muchisimo. Es mucho mas simple tu planteamiento y a la vez mas eficaz. Me sirvió ademas para adaptarlo cuando hay criterios repetidos.. comparto el codigo. Genial muchas gracias

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub filtro()
 
    Dim celda As Range
    Dim mirango(114), desti, fecha As String
    Dim ultimaFila As Long
    Dim ultimaColumna As Integer
    Dim i As Integer
 
    desti = ActiveWorkbook.Path & "\"
    fecha = " " & Format(Now, "dmmmyyyy") & ".xlsx"
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
 
    ultimaFila = Cells(Rows.Count, 1).End(xlUp).Row
 
 
    Range(Cells(1, 5), Cells(ultimaFila, 5)).Copy Range("AN1")
 
    Columns("AN:AN").Select
    ActiveSheet.Range(Cells(1, 40), Cells(ultimaFila, 40)).RemoveDuplicates Columns:=1, Header:= _
        xlYes
 
    Range("AN1:AN114").Select
 
    For Each celda In Selection
        mirango(i) = celda.Value
        Range("A1:X1").Select
        Selection.AutoFilter
        ActiveSheet.Range(Cells(1, 1), Cells(ultimaFila, 24)).AutoFilter _
            Field:=5, Criteria1:=mirango(i)
 
        Range("A1").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Range(Cells(1, 1), Cells(ultimaFila, 24)).Select
        Selection.Copy
 
        Workbooks.Add
        ActiveSheet.Paste
 
        Columns("A:X").Select
        Columns("A:X").EntireColumn.AutoFit
        Range("A1").Select
 
        ActiveWorkbook.SaveAs Filename:=desti & mirango(i) & fecha, _
                              FileFormat:=xlOpenXMLWorkbook, _
                              CreateBackup:=False
 
        ActiveWorkbook.Close
 
        i = i + 1
    Next celda
 
    Selection.AutoFilter
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
    Range("A1").Select
 
End Sub
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