Foro Excel

Desde ya muchas gracias por la atención que pueda merecer de vuestra parte.
Adjunto un archivo en el que explico detalladamente el caso, y el ejemplo del resultado

Gracias, Jorge

Dos comentarios a priori:

1º) Comienza por corregir tu tabla de datos: tienes "panadería" con y sin acento y "almacén" con y sin acento. La significación de estos ajustes es obvia: si quieres obtener una distribución de datos en base a un campo determinado, ese campo debe estar perfectamente conformado.

2º) Los inter-espacios que se advierten entre trabajador y trabajador: ¿Son a modo de facilitar nuestra comprensión del tema, o los tienes y los quieres en verdad?...

Saludos, Cacho R.

Amigo Cacho, tiene usted mucha razón, tal vez por el apuro de poner el ejemplo, " NO ME PERCATÉ" de ello de los acentos:
1) Por favor, agradeceré considerar para todos los efectos ALMACEN y PANADERIA sin tildes
2) Los interespación sólo es para ilustración, NO DEBEN IR

Gracias por su atención, espero su amable respuesta

Saludos

Con estas nuevas aclaraciones "la cosa" torna sencilla, entonces. Veamos...

Amigo CachoR, disculpe usted la molestia, ya que seguramente está bastante ocupado en sus obligaciones. Deseaba saber si tiene alguna respuesta respecto al tema?

Gracias nuevamente

Saludos, Jorge

Te pido cientos de disculpas, callao2908: estaba convencido que en mi mensaje anterior había adjuntado una propuesta para tu dificultad... ¡pero debo haberme equivocado al publicarla!

Analiza/prueba, entonces, el siguiente código:

Código: Seleccionar todo

Sub DistribuyeEnAreas()
Dim qCol As Integer, qRow As Long, firstR As Long, lastR As Long
Dim C As Range, mySh As Worksheet
Set mySh = ActiveSheet

qCol = Cells(1, Columns.Count).End(xlToLeft).Column
qRow = Cells(Rows.Count, "a").End(xlUp).Row
Range("a1", Cells(qRow, qCol)).Sort _
  Key1:=[a1], Order1:=xlAscending, Key2:=[b1], Order2:=xlAscending, Header:=xlYes
qRow = Cells(Rows.Count, "a").End(xlUp).Row

Range("a1", Cells(qRow, 1)).AdvancedFilter xlFilterCopy, , [ag1], True

lastR = 1
On Error GoTo err_NewSheet
For Each C In Range("ag2", [ag1].End(xlDown))
  With Range("a1", Cells(qRow, 1))
    firstR = .Find(What:=C, After:=Cells(lastR, "a"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
    lastR = .Find(What:=C, After:=Cells(firstR, "a"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
  End With
  With Sheets(Cells(lastR, "c").Value)
    Range(Cells(firstR, "a"), Cells(lastR, qCol)).Copy .Cells(Rows.Count, "a").End(xlUp).Offset(1)
  End With
Next C

Set mySh = Nothing
[ag1].CurrentRegion.Delete xlShiftUp
Exit Sub

err_NewSheet:
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = mySh.Cells(lastR, "c")
mySh.Activate
Range("a1", Cells(1, qCol)).Copy Sheets(Cells(lastR, "c").Value).[a1]
Resume
End Sub

En esta macro, está previsto que si una hoja no existe, entonces es creada para alojar allí la info correspondiente.

Saludos, Cacho.

Amigo CachoR, no tengo nada que disculpar, más bien agradecerle. La macro está funcionando bien, pero bota un pequeño error al copiar las fechas a las otras hojas.
Le adjunto el archivo para que le haga su verificación

Muchas gracias

Jorge

La problemática es sencilla de describir, mas la solución la tienes que evaluar tú. Veamos:

a) Selecciona cualquier celda del rango B3:B14 de la hoja Hoja1
b) ¿Adviertes que son fórmulas?...

¡Ése es el problema!...

Aunque no lo hayas aclarado, yo asumí que las fechas (en tu archivo real) son valores fijos y no fórmulas.
En tal caso, no tendrías ningún inconveniente con la macro mostrada.

Y aquí es donde vendría tu toma de decisión: si mi hipótesis es correcta entonces no hay problemas.
De no ser así deberás abundar en detalles sobre esa cuestión.

Saludos, Cacho R.

Gracias CachoR, ya rectifiqué lo de las formulas. Corrió perfecto. éste fin de semana voy a adaptarlo a mi archivo oficial. Te estoy comentando

Buen fin de semana, saludos

Jorge

Veremos, entonces, como te ha ido.

Aprovecho a incorporar dos líneas más de código: los "Application.ScreenUpdating" a los efectos de hacer mucho más rápida la ejecución.

Saludos, Cacho R.

Gracias amigo CachoR, funcionó bien. Puede dar el tema por CERRADO.

Hasta una próxima oportunidad

Saludos, Jorge