Copiar datos a celdas según criterios Excel-Actualizar
Nuevamente solicitando de su ayuda con un KARDEX es pegar los datos de los productos y pegar las referencias en las hojas creadas para un mayor detalle le adjunto la respuesta que me dio con la pregunta que le realice.
Copiar datos a hojas según criterios Excel
Gracias por la atención prestada
Slds
Robert
1 respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo la macro actualizada
Sub CrearHojas()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("PRIN")
'
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
End If
'
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")
End If
'
n = 2
j = 0
k = 16
For i = 4 To u2
If j = 40 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")
'
n = n + 1
j = 1
k = 16
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
h1.Columns("AA:AN").Clear
Application.ScreenUpdating = True
MsgBox "Hojas Creadas"
End Subs a l u d o s
