Macro que genera un listado con registros que cumplan cierta condición

20/02/2007 - 00:32 por Insumos | Informe spam
Hola Gente del Foro:
En una hoja llamada "Parámetros" hay una lista de nombres en la columna C,
de los cuales el primero esta en la celda C2. Por cada nombre hay una hoja
que se llama exactamente igual a cada nombre en la lista. En cada hoja de
cada nombre de la lista hay cierta información en la forma de registros. Yo
quiero hacer una macro que me compile la información que reúna ciertos
requisitos y me construya un reporte con los registros apropiados en una
hoja llamada "Contabilidad".
Asi la macro deberia ir hoja por hoja (del listado de nombres) y hacer lo
siguiente:
Si la celda "A2" esta vacia quiere decir que en esa hoja no hay registros,
entonces que siga con la siguiente hoja.
Ahora cuando llega a una hoja que tenga registros (por lo tanto la celda A2
no estaria vacia) debe mirar en la columna B a partir de la celda B2 (ya que
el la fila 1 hay encabezados). Allí debe chequear celda por celda en la
columna B el resultado de una fórmula lógica que ya se encuentra en esa
celda previamente (hay una formula del tipo que devuelve VERDADERO o FALSO).
Si encuentra que el resultado es VERDADERO o TRUE debe seleccionar toda la
fila y copiarla en la hoja "Contabilidad" a continuación del último registro
ya copiado. Si encuentra que es FALSO o FALSE debe ignorarla y pasar a la
siguiente celda. Así debe chequear registro por registro desde el primero,
que estaria en la fila 2, hasta el último que estaria en una fila número X
(ya que cada hoja tiene distinta cantidad de registros). Luego pasaria a la
siguiente hoja.
Y asi hoja por hoja hasta completar todos los nombres de la lista.
Hize la macro que incluyo más abajo, la cual funciona bien en todo excepto
que en las hojas que hay muchos registros con el resultado VERDADERO en la
columna B solo trae el primero que es VERDADERO y luego no trae los demás
que sean VERDADEROS. No entiendo porque, ya que creo que hize todo bien,
pero como mis conocimientos son muy limitados en estos de los códigos algo
seguro se me esta pasando.
Espero que me haya explicado bien! Desde ya muchas gracias!!

Sub Conta()

Application.ScreenUpdating = False
Sheets("Contabilidad").Select
Columns("A:I").ClearContents
Range("A1").Select
celda = ActiveCell.Address

Dim rAngo As Range
Dim rCell As Range

Sheets("Parámetros").Select
Range("C2").Select
Do While ActiveCell <> Empty
name = ActiveCell
Bb = ActiveCell.Address
Sheets(name).Select
Range("A2").Select
If ActiveCell.FormulaR1C1 = Empty Then
GoTo 30
Else
Range("B1").Select
Selection.End(xlDown).Select
Mm = ActiveCell.Address
Set rAngo = Range("B2:" + Mm)
For Each rCell In rAngo
If ActiveCell = True Then
rCell.EntireRow.Select
Selection.Copy
Sheets("Contabilidad").Select
Range(celda).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(1, 0).Select
celda = ActiveCell.Address
End If
Next rCell
End If
30
Sheets("Parámetros").Select
Range(Bb).Select
ActiveCell.Offset(1, 0).Select
Loop

Sheets("Controles").Select
Application.ScreenUpdating = True
Range("A1").Select

End Sub


CONTADURIA
 

Leer las respuestas

#1 Ivan
20/02/2007 - 03:49 | Informe spam
hola,

mira a ver si te puede valer esto. En teoria hace lo que pides. Si te
diera algun problema con el tipo Boolean de Verdadero/True (que parece
que no, pero a mi en alguna ocasion similar me ha mareado bastante)
cambia esto ->

If celda2 = True Then

por esto -> If cBol(celda2) = True Then

Sub CopiarFilasVerdadero()
Dim celda As Range, celda2 As Range
With Worksheets("Parametros")
If .Range("c2") = "" Then Exit Sub
For Each celda In .Range("c2:c" & _
.[c65536].End(xlUp).Row)
With Worksheets(celda.Value)
If .[a2] <> "" Then
For Each celda2 In .Range("b2:b" & _
.[b65536].End(xlUp).Row)
If celda2 = True Then
celda2.EntireRow.Copy
Worksheets("Contabilidad").[a65536] _
.End(xlUp).Offset(1) _
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
End If
Next
End If
End With
Next
End With
End Sub

bueno, espero te ayude

un saludo
Ivan

Preguntas similares