Buscarv en botón Macro
Hola, necesito lo siguiente:
Al hacer clic en un botón se de la opción de abrir un archivo (siempre serán diferentes nombres pero las mismas columnas y los datos varían), al abrir deberá hacer un buscarv con los siguientes parámetros, tomar todos los datos que están en la columna C (archivo actual) y buscarlo en el archivo que se esta abriendo en columnas (C a la Q) Y al encontrar los datos traer los datos de la columna Q y pegarlos en en archivo actual en la columna F, Atento a cualquier comentario
1 respuesta
Pon este código en la programación del botón. Busca el dato de la columna C del archivo 1 en el rango de columnas C:P del archivo 2. Si lo encuentra copia el dato de la columna Q (de la fila donde ha encontrado el valor) en el archivo 1, fila original en la columna F. Si no lo encuentra, marca en rojo la celda del archivo 1, y sigue con la siguiente.
La macro es esta:
Public Este libro, LibroNuevo, Dato, Dato2, Celda1, Celda2 As String
Public c As Byte
Sub AbrirArchivo()
Este libro = ThisWorkbook.Name
strArchivo = Application.GetOpenFilename
On Error GoTo 99
Workbooks.OpenText Filename:=strArchivo
If strArchivo = "" Then Exit Sub
strArchivo = ActiveWindow.Caption
99:
LibroNuevo = ActiveWorkbook.Name
Windows(Este libro).Activate
Dim b As Byte 'numero de celdas en blanco
Range("c1").Select
Abuscar:
c = 3 'numero de columna, empezará por la C
If b = 3 Then 'si se encuentra 3 celdas vacías acaba la macro
Range("c1").Select
Exit Sub
End If
If ActiveCell = "" Then GoTo Blanco
b = 0
Celda1 = ActiveCell.Address
Dato = ActiveCell
Application.ScreenUpdating = False
Workbooks(LibroNuevo).Activate
BuscaPorColumnas:
Columns(c).Select
If c > 16 Then 'si no encuentra el dato en ninguna columna lo marca en rojo y sigue con el siguiente
Workbooks(Este libro).Activate
Range(Celda1).Select
Application.ScreenUpdating = True
ActiveCell.Interior.ColorIndex = 3
Application.ScreenUpdating = False
ActiveCell.Offset(1, 0).Select
GoTo Abuscar
End If
On Error Resume Next
Selection.Find(What:=Dato, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err.Number <> 0 Then
Err.Number = 0
c = c + 1
GoTo BuscaPorColumnas 'si no encuentra el dato en la columna, cambia
Else
Celda2 = ActiveCell.Row
Dato2 = Range("Q" & Celda2).Value
Workbooks(Este libro).Activate
Range(Celda1).Select
Application.ScreenUpdating = True
ActiveCell.Offset(0, 3) = Dato2
ActiveCell.Offset(1, 0).Select
End If
GoTo Abuscar
Blanco:
ActiveCell.Offset(1, 0).Select
b = b + 1 'si la celda está en blanco suma 1 a b y sigue
GoTo Abuscar
End Sub
Ponlo como programación de tu botón, y dime algo.
