Macro para selección automática de valores en una lista desplegable y que luego ejecute una macro que ya tengo hecha

Tengo un archivo de Excel y utilizo una lista desplegable para seleccionar datos y posteriormente hacer una macro para guardar ciertos datos del dato seleccionado en un archivo aparte.

For Each c In Sheets("CATALOGO ").Range("F3:F9")
Sheets("MATERIALES").[B1] = c.Value
Next
' aquí pongo la macro que ya tengo hecha

Estoy usando ese código para que seleccione los datos de la lista, pero no me guarda todos los archivos de todos los valores solo de uno, ¿me podría apoyar?

1 Respuesta

Respuesta
3

Tienes que poner el código para guardar el archivo dentro del for:

Sub tst()
  For Each c In Sheets("CATALOGO ").Range("F3:F9")
    Sheets("MATERIALES").[B1] = c.Value
    'Inicio
    'código para guardar el archivo
    'Fin
  Next
End Sub

Muchas gracias por responder, ya lo puse así y no me guarda los archivos de todos los datos de la lista, solo de uno y se cicla en ese mismo dato.

¿Qué se puede hacer?

Puedes poner aquí la macro completa

Si, claro, la anexo:

Sub INTENTO()
'
' INTENTO Macro
'
Dim NOMBRE As String, RUTA As String
RUTA = "C:\Users\" & Environ("UserName") & "\Downloads"
NOMBRE = "PLANTILLA_" & "_" & Range("A1") & "_" & Range("B1").Value
For Each c In Sheets("CATALOGO ").Range("F3:F9")
    Sheets("MATERIALES").[B1] = c.Value
    Range("C3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Workbooks.Open Filename:="C:\Users\" & Environ("UserName") & "\Downloads\Materiales.xlsx"
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E1").Select
    ActiveSheet.Range("$1:$1048576").AutoFilter Field:=5, Criteria1:="0.00%"
    Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("G2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    ActiveSheet.Range("$1:$1048576").AutoFilter Field:=5
    ActiveWorkbook.SaveAs Filename:=RUTA & "\" & NOMBRE & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
Next
End Sub

Esta línea también debe ir dentro

    NOMBRE = "PLANTILLA_" & "_" & Range("A1") & "_" & Sheets("MATERIALES").Range("B1").Value

Prueba así:

Sub INTENTO()
'
' INTENTO Macro
'
Dim NOMBRE As String, RUTA As String
RUTA = "C:\Users\" & Environ("UserName") & "\Downloads"
For Each c In Sheets("CATALOGO ").Range("F3:F9")
    Sheets("MATERIALES").[B1] = c.Value
    NOMBRE = "PLANTILLA_" & "_" & Range("A1") & "_" & Sheets("MATERIALES").Range("B1").Value
    Range("C3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Workbooks.Open Filename:="C:\Users\" & Environ("UserName") & "\Downloads\Materiales.xlsx"
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E1").Select
    ActiveSheet.Range("$1:$1048576").AutoFilter Field:=5, Criteria1:="0.00%"
    Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("G2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    ActiveSheet.Range("$1:$1048576").AutoFilter Field:=5
    ActiveWorkbook.SaveAs Filename:=RUTA & "\" & NOMBRE & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
Next
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas