Generar hojas según criterios de búsqueda Excel
Nuevamente solicitando de su ayuda, he tomado como ejemplo un código con el cual usted me ayudo hace un tiempo(Mejorar macro Copiar datos a hojas según criterios Excel ) en la cual es generar hojas según criterios de búsqueda en un formato de hoja fijo.
He intentado adaptar el código a otra para otra actividad en la cual que se generen hojas de acuerdo a un área determinada y separada por tipo de insumo
En la imagen se observa la base de datos y en una vista más pequeña las áreas el código que he tratado de adaptar es que según la lista busque en la columna áreas los insumos y que genere las hojas según el formato ya establecido de las cuales en la misma hojas hay tres tipos de hojas separadas por tipo de insumo.
Este es el formato de la hoja en la cual en la parte superior esta los productos con tipo de insumo semielaborados líneas más abajo están los perecibles y más abajo los no perecibles.
El código que adapte al ejecutar me sale de la siguiente manera. Me ubica los productos líneas más abajo de lo que asigne.
Este el código, me puede ayudar para los ubicar los productos en la posición correcta ( la variable K que indica la posición de los semielaborados, la variable W indica la posición de los perecibles, la variable Z indica la posición de los no perecibles)
Gracias por la atención prestada
Slds.
Robert
1 Respuesta
Hola Dante,
Acabo de enviarle a su correo.
Gracias
Slds
Robert
Hola Dante,
Acabo de enviarle el archivo a su correo
Gracias
Slds
Robert
Te anexo la macro actualizada
Sub genera_formatos()
'Act.Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("Hoja2")
Set h2 = Sheets("formato")
Set h4 = Sheets("requerimiento")
For m = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
h4.[z1] = "AREAS"
h4.[z2] = h1.Cells(m, "A")
h4.Columns("AA:AV").Clear
u = h4.Range("V" & Rows.Count).End(xlUp).Row
h4.Range("A1:V" & u).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h4.Range("z1:z2"), CopyToRange:=h4.Range("AA3"), Unique:=False
'
u2 = h4.Range("AA" & Rows.Count).End(xlUp).Row
If u2 > 3 Then
nombre = h4.[z2]
'
On Error Resume Next
Sheets(nombre).Delete
On Error GoTo 0
'
h2.Copy after:=Sheets(Sheets.Count)
Set h3 = ActiveSheet
h3.Name = nombre
h3.Range("B2, B54, B106") = nombre
'
k = 4: w = 56: z = 108
For i = 4 To u2
If h4.Cells(i, "ai") = "SEMIELABORADOS" Then
h3.Cells(k, "A") = h4.Cells(i, "Ab")
h3.Cells(k, "B") = h4.Cells(i, "Ac")
h3.Cells(k, "C") = h4.Cells(i, "Af")
k = k + 1
ElseIf h4.Cells(i, "ai") = "PERECIBLES" Then
h3.Cells(w, "A") = h4.Cells(i, "Ab")
h3.Cells(w, "B") = h4.Cells(i, "Ac")
h3.Cells(w, "C") = h4.Cells(i, "Af")
w = w + 1
ElseIf h4.Cells(i, "ai") = "NO PERECIBLES" Then
h3.Cells(z, "A") = h4.Cells(i, "Ab")
h3.Cells(z, "B") = h4.Cells(i, "Ac")
h3.Cells(z, "C") = h4.Cells(i, "Af")
z = z + 1
End If
Next
End If
h4.Columns("AA:AZ").Clear
Next
Application.ScreenUpdating = True
MsgBox "Hojas Creadas"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
