Mejorar macro Copiar datos a hojas según criterios Excel
Hace un tiempo me ayudo con una macro para copiar datos en hojas según criterios
Copiar datos a hojas según criterios Excel
Pero me ayudaría a mejorarla si se puede en la que ya no sea necesario pegar el código del producto en referencia si que según una lista busque los productos uno a uno y genere las hojas según las lista.
Esta la hoja de la lista en la cual según la lista de artículos que busque en la base de datos y genere las hojas
esta la base de datos a buscar
Gracias por la atención prestada
Slds
Robert
1 respuesta
Respuesta de Dante Amor
1
Hola Dante,
Ya le envié el archivo
Slds
Robert
Te anexo la macro actualizada
Sub CrearHojas()
'Por.Dante Amor
On Error Resume Next
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("PRIN")
Set h4 = Sheets("LISTA")
'
For m = 2 To h4.Range("A" & Rows.Count).End(xlUp).Row
h1.[C2] = h4.Cells(m, "A")
h1.Columns("AA:AN").Clear
u = h1.Range("B" & Rows.Count).End(xlUp).Row
h1.Range("A3:N" & u).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h1.Range("C1:C2"), CopyToRange:=h1.Range("AA3"), Unique:=False
'
u2 = h1.Range("AB" & Rows.Count).End(xlUp).Row
If u2 > 3 Then
'MsgBox "No existen registros con esa referencia"
'Exit Sub
'
nombre = h1.Range("AC4")
h2.Copy after:=Sheets(Sheets.Count)
Set h3 = ActiveSheet
h3.Name = nombre
Set b = h1.Columns("B").Find(h1.[C2], lookat:=xlWhole)
If Not b Is Nothing Then
h3.[C8] = h1.Cells(b.Row, "B")
h3.[B10] = h1.Cells(b.Row, "C")
h3.[D11] = h1.Cells(b.Row, "N")
h3.[B9] = h1.Cells(b.Row, "M")
End If
'
n = 2
j = 0
k = 17
For i = 4 To u2
If j = 39 Then
h2.Copy after:=Sheets(Sheets.Count)
Set h3 = ActiveSheet
h3.Name = nombre & " " & n
h3.[C8] = h1.Cells(b.Row, "B")
h3.[B10] = h1.Cells(b.Row, "C")
h3.[D11] = h1.Cells(b.Row, "N")
h3.[B9] = h1.Cells(b.Row, "M")
'
n = n + 1
j = 1
k = 17
End If
h3.Cells(k, "A") = h1.Cells(i, "AJ")
h3.Cells(k, "B") = h1.Cells(i, "AF")
h3.Cells(k, "C") = h1.Cells(i, "AG")
h3.Cells(k, "D") = h1.Cells(i, "AH")
'h3.Cells(k, "E") = h1.Cells(i, "AD")
If h1.Cells(i, "AD") = "ENTRADAS" Then
h3.Cells(k, "F") = h1.Cells(i, "AE")
Else
h3.Cells(k, "G") = h1.Cells(i, "AE")
End If
j = j + 1
k = k + 1
Next
End If
h1.Columns("AA:AN").Clear
Next
Application.ScreenUpdating = True
MsgBox "Hojas Creadas"
End Sub':) 'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias ':)
¡Gracias! Millón gracias Dante maestro si pudiera le daría más puntos a la calificación que para mi es muy corta
un millón de gracias ...
slds
Robert.
