Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim Ws1 As Worksheet 'Hoja1
Dim Ws2 As Worksheet 'Hoja2
Dim WsD As Worksheet 'Hoja3
Dim i As Long 'Para recorrer las filas de la hoja 2
'como no sabemos cuantas filas hay elegimos
'Long por si acaso
Dim j As Long 'Para recorrer las filas de la hoja 3
'como no sabemos cuantas filas hay elegimos
'Long por si acaso
'Salimos si:
' La columna de la seleccion no es la primera
' La fila de la seleccion es la primera
' Se seleccionan mas de una celda
' Se selecciona una celda vacia
If Target.Column <> 1 Or Target.Row = 1 Or Target.Count > 1 Or _
Len(Target) = 0 Then Exit Sub
On Error GoTo ErrHandler
'Congelamos la pantalla para acelerar el propceso
Application.ScreenUpdating = False
Set Ws1 = Me
Set Ws2 = ThisWorkbook.Worksheets("Hoja2")
Set WsD = ThisWorkbook.Worksheets.Add
i = 2
j = 2
'Encabezados de la hoja 3
WsD.Cells(1, 1) = "Producto"
WsD.Cells(1, 2) = "Valor"
WsD.Cells(1, 3) = "Margen"
'Buscamos en la Hoja2 hasta encontrarnos con una celda vacia
Do Until Len(Ws2.Cells(i, 1)) = 0
If Ws2.Cells(i, 1) = Target Then
WsD.Cells(j, 1) = Ws2.Cells(i, 1)
WsD.Cells(j, 2) = Ws2.Cells(i, 2)
WsD.Cells(j, 3) = Ws2.Cells(i, 3)
j = j + 1
End If
i = i + 1
Loop
WsD.Select
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
Application.ScreenUpdating = True
MsgBox "Ha habido un error a lo largo de la ejecución de la macro. " & _
"Esta no ha podido ser ejecutada en su totalidad.", vbOKOnly + _
vbCritical, "Atención"
End Sub
Más mascado imposible, jeje. Espero haberte podido ayudar.
Un saludo.
Working Into Binary (WIB) - http://workingintobinary.blogspot.com.es/
