Macro para separar meses, tengo columna A con varios meses, debo separa el archivo en varios archivos, uno por mes y guardarlo.

En un archivo la columna A lleva la fecha y son varios meses incluso años, debo separar por mes y guardar cada archivo

1 Respuesta

Respuesta
1

Ho la y bienvenido a TodoExpertos:

Te invito a SUSCRIBIRTE a mi canal de YouTube:

Excel y Macros

Ahí encontrarás más sobre Excel y Macros:

https://www.youtube.com/channel/UCs644-v3ti4SF7zE_bt_YXA 

Comparte los enlaces en tus redes sociales.


Te ayudo con la macro, pero deberás ser más específico con el resultado, proporciona los siguientes datos:

- Ejemplo de cómo están los datos en tu hoja, puedes poner datos genéricos.

- Cómo se llama tu hoja donde están los datos.

- ¿Quieres un archivo por cada mes?

- ¿Cómo se va a llamar el archivo?

- ¿En cuál carpeta se va a guardar el archivo?

- Aproximadamente cuántos registros hay en tu hoja.

- ¿Los datos está ordenados por fecha?

- Dices que en la columna A tienes una fecha, ¿puedes poner un ejemplo?

- ¿Cuáles columnas se van a guardar? ¿Todas? ¿Hasta cuál columna llegan tus datos?

- ¿En cuál fila empiezan tus datos?

Hola el archivo tiene 12 columnas de la A a la L,

Los datos empiezan en la fila 5 con los encabezados y en la fila 6 empieza la información,

La información llega hasta la fila 20443 en forma de lista

Los daton son genéricos pero hay columnas con formato de numero, otras con formato de texto y otra con formato de fechas

El formato de fecha que se ocuo es DD/MMM/AAAA, ejemplo 21/12/2021

Todo estaordenado por fecha

Las fechas abarcan los 12 meses y en otros archivos también están varios años por decir si tengo un archivo desde enero del 2020 serian 34 meses pero obvio van me a mes

La hoja se llama Hoja, y el archivo se llama Sellout

Se va a dividir por mes cada uno con sus 9 columnas

Se va a guardar en Mis Documentos

Se necesita un archivo por mes

Se va a guardar cada archivo con el nombre Sellout y un numero consecutivo para cada mes ejemplo, sellout1, sellout2, sellout3 y así consecutivamente

Si tienes febrero de 2020 y también tienes febrero de 2021 y también tienes febrero de 2022.

¿Solamente quieres un archivo con el nombre sellout2?

Prueba la siguiente macro:

Sub SepararMes()
'Por Dante Amor
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim wb2 As Workbook
  Dim lr As Long, mes As Long
  Dim ruta As String
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  Set sh1 = Sheets("Hoja")     'nombre de la hoja con datos
  ruta = Environ$("USERPROFILE") & "\Documents\"
  '
  If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
  lr = sh1.Range("A" & Rows.Count).End(3).Row
  '
  For mes = 21 To 32
    With sh1.Range("A5:J" & lr)
      .AutoFilter Field:=1, Criteria1:=mes, Operator:=xlFilterDynamic
      .Copy
    End With
    Set wb2 = Workbooks.Add(xlWBATWorksheet)
    Set sh2 = wb2.Sheets(1)
    sh2.Range("A5").PasteSpecial xlPasteAll
    wb2.SaveAs ruta & "Sellout" & mes - 20 & ".xlsx", xlOpenXMLWorkbook
    wb2.Close False
  Next
  MsgBox "Fin", vbInformation, "Excel y Macros"
End Sub

Me parece que faltaron algunos detalles que especificaras.

En cuál celda se van a pegar los datos y si se van a pegar como valores o con formatos.

Prueba, revisa los archivos generados y comenta.

Hola va genial la macro solu que al llegar a la línea Set sh2 = wb2.Sheets() no avanza crea el archivo nuevo vacío pero no pega la información.

Me puedes seguir ayudando por favor mi trabajo depende de esta macro,

Se necesita un archivo por mes 

se penga desde la Fila 5 Columna A con los encabezados

Se pegan con formatos

Te aparece un mensaje de error.

¿Qué dice el mensaje?

¿Modificaste algo en la macro?

Hola, esta todo excelente muchísimas gracias por tu ayuda

Si me lo permites tengo 3 dudas

Cuando pones For mes = 21 To 32 que significa ese 21 para 32

Cuando pones wb2.SaveAs ruta & "Sellout" & mes - 20 & ".xlsx", xlOpenXMLWorkbook que significa & mes menos 20

Por ultimo tenis razón primero debería dividir el archivo por año por que esta agrupando el mes de cada año en los archivos que se generan, que debería modificar para hacer la misma macro pero que separe por año, y luego corro esta para separar por mes

Gracias

Respondo tus dudas:

1. "Cuando pones For mes = 21 To 32 que significa ese 21 para 32"

Esta instrucción, filtra por mes, pero el criterio para enero empieza en 21, por eso el ciclo va desde el 21 (enero) hasta el 32 (diciembre)

.AutoFilter Field:=1, Criteria1:=mes, Operator:=xlFilterDynamic

2. "Que significa & mes menos 20"

En la instrucción anterior le puse 21, entonces le resto 20, para tener 1 (enero)

3. "Por ultimo tenis razón primero debería dividir el archivo por año"

La macro podría dividir por mes-año y que el nombre del archivo sea mes-año, por ejemplo:

"Sellout-1-2021"

"Sellout-1-2022"


Sal u dos.

Genial me apoyas para modificar la macro y que guarde como dices por mes y año

Te paso la macro para separar por mes y año:

Sub SepararMesAño()
'Por Dante Amor
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim wb2 As Workbook
  Dim lr As Long, lr2 As Long, mes As Long, nMin As Long, nMax As Long, año As Long
  Dim ruta As String, fec1 As String, fec2 As String
  Dim dia As Long
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  Set sh1 = Sheets("Hoja")     'nombre de la hoja con datos
  ruta = Environ$("USERPROFILE") & "\Documents\"
  '
  If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
  lr = sh1.Range("A" & Rows.Count).End(3).Row
  '
  nMin = Year(WorksheetFunction.Min(sh1.Range("A5:J" & lr)))
  nMax = Year(WorksheetFunction.Max(sh1.Range("A5:J" & lr)))
  '
  For año = nMin To nMax
    For mes = 1 To 12
      fec1 = "01/" & Format(mes, "00") & "/" & año
      dia = Day(DateSerial(año, mes + 1, 1) - 1)
      fec2 = dia & "/" & Format(mes, "00") & "/" & año
      With sh1.Range("A5:J" & lr)
        .AutoFilter Field:=1, _
          Criteria1:=">=" & Format(CDate(fec1), "mm/dd/yyyy"), Operator:=xlAnd, _
          Criteria2:="<=" & Format(CDate(fec2), "mm/dd/yyyy")
        '
        lr2 = sh1.Range("A" & Rows.Count).End(3).Row
        If lr2 > 5 Then
          .Copy
          Set wb2 = Workbooks.Add(xlWBATWorksheet)
          Set sh2 = wb2.Sheets(1)
          sh2.Range("A5").PasteSpecial xlPasteAll
          wb2.SaveAs ruta & "Sellout-" & Format(mes, "00") & "-" & año & ".xlsx", xlOpenXMLWorkbook
          wb2.Close False
        End If
        .AutoFilter
      End With
    Next
  Next
  MsgBox "Fin", vbInformation, "Excel y Macros"
End Sub

'

No olvidar suscribirte a mi canal y compartir los enlaces:

Gra cias

Muchísimas gracias funciona a la perfección, la verdad hay algunas líneas que ya son muy avanzadas para mi, te debo una coca y una torta o lo que gustes hasta una botella del licor que prefieras, mi correo es [email protected]

[Encantado de ayudarte, me alegra saber que funciona para ti.

Te comparto mi correo:

[email protected]

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas