Macro para buscar un valor y copiar la fila completa si lo encuentra

Tengo un libro con muchas hojas, necesito que con una user form donde
los valores que puede encontrar son "P" o "E", S, T, y V. Que busque
esos valores en la columna N comenzando desde la N5 hasta la cantidad de
celdas que estén llenas. Si encuentra el valor que copie toda la fila y
la pegue en una hoja llamada "BASE" y que esto lo haga en todas las
hojas del libro.

1

1 respuesta

Respuesta
1

No estoy seguro de entender lo que quieres por tus explicaciones. De todos modos el siguiente código hace lo que creo necesitas, salvo que no toma el valor a buscar de un UserForm, sino que usa varios valores de un array. Tendrás que modificar esa parte para tomar el valor del control del userform que tengas. Te lo he separado por funciones porque creo que es más claro el código y porque lo puedas modificar más fácilmente.

Option Explicit
Const HB = "BASE"
Dim CTipos(4) As String
Sub InitConst()
'Inicializa los valores a buscar
CTipos(0) = "P"
CTipos(1) = "E"
CTipos(2) = "S"
CTipos(3) = "T"
CTipos(4) = "V"
End Sub
Function EsValorBuscado(v As String) As Boolean
'BUsca si es el valor buscado
Select Case v
 Case CTipos(0), CTipos(1), CTipos(2), CTipos(3), CTipos(4)
 EsValorBuscado = True
 Case Else
 EsValorBuscado = False
End Select
End Function
Sub CopiaFilas()
'Copia filas a la hoja "BASE" basadas en valores de la columna N
Dim h As Worksheet
Dim i As Integer
Dim maxj As Integer
'Inicializa los valores a buscar
Call InitConst
'Recorre las hojas
For Each h In ThisWorkbook.Sheets
 'Y los valores de la columna N
 If h.Name <> HB Then
 For i = 5 To h.Range("N65000").End(xlUp).Row
 If EsValorBuscado(h.Range("N" & i).Value) Then 'Hay que copiar la fila
 maxj = 1 + Worksheets(HB).Range("A65000").End(xlUp).Row
 h.Range("N" & i).EntireRow.Copy _
 Destination:=Worksheets(HB).Range("A" & maxj)
 End If
 Next i
 End If
Next h
End Sub

Supongo que no tienes miles de filas, porque por ejemplo para el cálculo de la última fila uso un entero y no se puede almacenar números demasiado grandes en enteros (32768).

Esta muy buena tu macro! pero hay cosas que no conozco aun voy a trabajar con ella a ver que aprendo y como me va! Una pregunta mas no entiendo muy bien como son los comandos para copiar una fila o columna completa, si yo le digo: que busque un valor en todas las filas de la columna N y que de encontrarlo copie esa columna tu lo hiciste pero no lo entiendo, si puedes explicármelo por favor te lo agradecería mucho y asi cerramos la pregunta!. Me has enseñado mucho y hasta he hecho macros yo solo jejejeje!

La línea que hace la copia es:

h.Range("N" & i).EntireRow.Copy _
 Destination:=Worksheets(HB). Range("A" & maxj)

donde i es el índice de la fila a copiar y maxj la fila donde copiar. En el cálculo de maxj y en el bucle uso la función End(xlup) que me da la última fila que tiene valores porque cuento desde abajo (un valor muy grande) hacia arriba. Si lo hago al revés, de arriba hacia abajo y hay una fila vacía pero luego sigue, se pararía ahí.

Por favor, cierra y valora la pregunta. Y si tienes otras cuestiones intentaré contestarlas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas