Macro para crear un archivo diferente por cada dato existente en cualquier fila de una misma columna
Necesito hacer una macro que cree un archivo que comience por los datos de las celdas de una misma columna. Estas celdas son 2 ó 3 letras/números en cada fila de la columna "B". Pueden ser iguales o diferentes. Por eso necesito que en cada archivo aparezcan las filas que contengas en la columna "B" estos dígitos letras/números. Detrás de estas 2 ó 3 letras/números debe aparecer el texto "_eventos_noviembre_2015.xls". Por ejemplo, "T2R_eventos_noviembre_2015.xls".
Los datos aparecerán en el archivo "eventos.xls" que está en la carpeta con la ruta "L:\Datos". Los archivos creados deben crearse en la carpeta "L:\Resultado".
Muchas gracias por vuestro tiempo y dedicación. Soy nuevo en esto y no sé como hacer la macro.
1 respuesta
H o l a:
Te anexo la macro para generar archivos.
También debes cambiar en esta línea de la macro, el texto que vas a utilizar para nombrar los archivos, reemplaza "texto" por lo que desees.
nombre = h2.Cells(i, "A") & "texto"
Sub CrearArchivos()
'Por.Dante Amor
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(1)
Set h2 = l1.Sheets(2)
'
ruta = l1.Path & "\"
h2.Cells.Clear
h1.Columns("B").Copy h2.Columns("A")
h1.Range("A1") = "Texto"
h1.Range("B1") = "Codigo"
h1.Range("D1") = "Codigo"
u1 = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("A1:A" & u1).RemoveDuplicates Columns:=1, Header:=xlYes
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To u2
If h1.FilterMode Then h1.ShowAllData
nombre = h2.Cells(i, "A") & "texto"
h1.[D2] = nombre
h1.Range("A1:B" & u1).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=h1.Range("D1:D2"), Unique:=False
Set l2 = Workbooks.Add
Set h3 = l2.Sheets(1)
h1.Range("A:B").Copy h3.[A1]
'l2.SaveAs Filename:=ruta & nombre & ".xlsx", FileFormat:=xlOpenXMLWorkbook
l2.SaveAs Filename:=ruta & nombre & ".xlsx", FileFormat:=xlNormal
l2.Close
Next
MsgBox "Proceso terminado", vbInformation
End Sub