Macro para buscar información en distintas pestañas y pegar datos en otra hoja
Tengo un archivo que tiene esta pantalla para buscar información de unos productos:
Yo ingreso el código A.F. Y la sociedad está en una lista desplegable y me llena todos los demás datos. Entre ellos está el Expediente de A.F. Yo hice una macro que cuando le doy listar AF del expediente, en la parte de abajo me trae todos los demás códigos que están en ese mismo expediente junto con el que ingresé en la búsqueda. La macro me funciona bien, solo que quiero hacerla más optima ya que por mi poco conocimiento de VBA la hice muy engorrosa, entonces quisiera saber de una manera para simplificarla.
Lo que quiero hacer es esto: tengo 4 hojas con bases de datos que tienen los mismos campos pero para cada sociedad, prácticamente todos los datos que se muestran en la pantalla que anexe. Cuando yo seleccione la sociedad y el código, me busque en la hoja que corresponde a la sociedad el numero del expediente y me traiga los datos que se muestran en la tabla de abajo. Pero hay 2 detalles, 1 cuando en status dice "De Baja" hay otro número de expediente que está en otra columna, ejemplo el número de expediente está en la F, el numero de expediente "de baja" está en la M. El segundo es que quiero que los datos que trae solo traiga código, serie y descripción, cuando llegue a 40, siga en las columnas de al lado, cuando vuelva a llegar a 40, continúe debajo de los primeros 40 y así, puede que no pase de 40 los códigos o puede que sean más de 40.
Yo hice algo que es lo que me puso el archivo pesado y era que tenia formulada una hoja llamada control donde me traía todo los que metía en las otras 4 hojas y básicamente la macro que hice, filtraba de esa hoja los datos que quería y las pegaba en otra hoja llamada datos del filtrado y tenia formulado la pantalla inicial para que me trajera todos los datos pero ahora el archivo pesa un montonón.
Esta es la macro
Sub Listar_Exp()
' Listar_Exp Macro
Application.ScreenUpdating = False
Criterio1 = [C10]
Sheets("Datos de Filtrado").Select
Range("A2").Select
ActiveCell.Rows("1:600").EntireRow.Select
Selection.ClearContents
ActiveCell.Select
Sheets("Buscador de Datos").Select
If Criterio1 = "De Baja" Then
Sheets("Control").Select
ActiveSheet.Range("$A$1:$R$39997").AutoFilter Field:=15
ActiveSheet.Range("$A$1:$R$39997").AutoFilter Field:=18, Criteria1:=Sheets("Buscador de Datos").Range("k3")
Sheets("Buscador de Datos").Select
Else
Sheets("Control").Select
ActiveSheet.Range("$A$1:$R$39997").AutoFilter Field:=18
ActiveSheet.Range("$A$1:$R$39997").AutoFilter Field:=15, Criteria1:=Sheets("Buscador de Datos").Range("k3")
Sheets("Buscador de Datos").Select
End If
Sheets("Control").Select
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datos de Filtrado").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Control").Select
Range("K2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datos de Filtrado").Select
Range("b2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Control").Select
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datos de Filtrado").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Buscador de Datos").Select
Range("C3:F3").Select
Application.ScreenUpdating = True
End Sub
1 Respuesta
HOla Dante, Fíjate, tengo esta hoja que se llama Buscador de Datos
En esta hoja yo selecciono Sociedad y Cod A.F. y con formulas me trae los demás Datos que están llenos. Cuando yo le doy al boton Listar AF del Expediente, con el número de expediente que está ahí me busca en la hoja que está identificada con el nombre de la sociedad (por ejemplo en este caso es VEPI) y me trae los datos que pido abajo, Cod A.F. Serial. A.F y Descripción de todos los códigos que estén en el mismo exp del codigo que ingresé arriba. los datos están esta hoja
Como esta hoja, hay otras 3 pero identificadas con el nombre de la sociedad y con los datos que corresponden a las mismas.
Si te fijas, en la Columna O y en la R hay números de expedientes pero el primero es el expediente original y en la R es cuando se crea el Exp de la baja.
Por eso cuando en la hoja de Buscar datos, ingreso un codigo de AF si en la celda C10 dice De baja, busca el numero de expediente en la columna R y si en la celda C10 no dice de baja, busca los números de expediente en la O.
Entonces lo que hago es buscar en la hoja de la sociedad el número de expediente y traerlo a la hoja de buscar datos en la parte de abajo, solo los datos que hay dicen y como es un formato para imprimir, hago que las primeras 40 lineas se peguen de la A a la C, las siguientes 40 se peguen de la I a la K. las siguientes 40, se peguen debajo de las que ya fueron pegadas de la A a C y así sucesivamente. Puede pasar que con el expediente no hayan mas de 40 códigos o puede que hayan muchos más.
Lo que estoy haciendo en este momento es optimizar el código o prácticamente haciéndolo de nuevo porque de la manera anterior se que es muy engorroso y hace que pese mucho el archivo.
En este momento me encuentro trabajando en ello con lo que he ido aprendiendo pero hay cosas que no se como hacerlas como por ejemplo, cuando seleccione una sociedad, busque los datos del expediente a listar en la hoja que le corresponda.
Atento a sus comentarios, me despido
Te anexo la macro, trabaja con cualquier hoja que pongas en la celda de sociedad.
Sub Listar_Expedientes()
'Por Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Buscador de Datos")
h1.Rows(14 & ":" & Rows.Count).ClearContents
'
'VALIDACIONES
soc = h1.Range("C2").Value 'sociedad
cod = h1.Range("K3").Value 'código
cri = h1.Range("C10").Value 'criterio (de baja)
If soc = "" Then
MsgBox "Falta la sociedad", vbCritical
Exit Sub
End If
If cod = "" Then
MsgBox "Falta la Código", vbCritical
Exit Sub
End If
existe = False
For Each h In Sheets
If LCase(h.Name) = LCase(soc) Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "La hoja de la sociedad no existe", vbCritical
Exit Sub
End If
'
'COPIA INFORMACIÓN
Set h2 = Sheets(soc)
If h2.AutoFilterMode Then h2.AutoFilterMode = False
If LCase(cri) = LCase("De Baja") Then campo = 18 Else campo = 15
col = 1
n = 0
For i = 2 To h2.Range("O" & Rows.Count).End(xlUp).Row
If h2.Cells(i, campo).Value = cod Then
j = h1.Cells(Rows.Count, col).End(xlUp).Row + 1
h1.Cells(j, col + 0).Value = h2.Cells(i, "D").Value
h1.Cells(j, col + 1).Value = h2.Cells(i, "K").Value
h1.Cells(j, col + 2).Value = h2.Cells(i, "E").Value
n = n + 1
If n = 40 Then
If col = 1 Then col = Columns("I").Column Else col = 1
n = 0
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
