Buenas noches maestros.

 

Solicito ayuda para lo siguiente: en la hoja1 tengo en la primera fila encabezados de productos: A1= ARROZ, B1= CARNE, C1= PAPAS, etc. Debajo de cada una de ellas hay cifras numericas que representan kilos. Luego en la hoja2, tengo los mismos productos pero en forma vertical y en la columna siguiente los kilos, es decir:

 columna B  columna C

ARROZ         10

CARNE        20

PAPA            5

Lo que necesito hacer es capturar uno a uno los productos de la columna B de la hoja2 y buscarlos la fila de encabezados de la hoja1 para conocer su posición, y en la fila de abajo pegar la cantidad de kilos de la columna C de la hoja2. Tiene que ser un codigo que permita buscar en un rango variable, pues constantemente se vana agregando o eliminando productos.Espero haberme dado a entender.

 

gracias de antemano.

Sube tu archivo y pon un ejemplo.

Hace 7 horas, Antoni dijo:

Sube tu archivo y pon un ejemplo.

Aquí va el archivo con el ejemplo Maestro. Tarté de hacer la rutina con este código pero no me funcionó

Private Sub BuscaryPegar()
Dim Rubro, Cantidad
Sheets("Hoja2").Visible = True
        Sheets("Hoja2").Select
For N = 2 To Sheets("Hoja2").Range("A" & Rows.Count).End(xlUp).Row
        Range("B" & N) = Rubro
        Range("F" & N) = Cantidad
 Sheets("Hoja1").Select
 Rows("1:1").Select
 Set RangoObj = Selection.Find(What:=Rubro, _
 After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
 xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
 MatchCase:=False, SearchFormat:=False)
 If RangoObj Is Nothing Then
 'If c = 0 Then
  MsgBox "No hay Dato"
 Else
RangoObj.Offset(1, 0).Select
ActiveCell = Cantidad
End If
Next
End Sub

 

Libro1.xlsm

Si he entendido bien, debería ser esto:

Private Sub BuscaryPegar()
Application.ScreenUpdating = False
Dim Fila As Range, Columna As Range, x As Long
For x = 2 To Hoja2.Range("A" & Rows.Count).End(xlUp).Row
   Set Columna = Hoja1.Rows(1).Find(Hoja2.Range("A" & x), , , xlWhole)
   If Not Columna Is Nothing Then
      Set Fila = Hoja1.Cells(Rows.Count, Columna.Column).End(xlUp).Offset(1)
      Hoja1.Cells(Fila.Row, Columna.Column) = Hoja2.Range("B" & x)
   End If
Next
End Sub

 

Hace 1 hora, Antoni dijo:

Si he entendido bien, debería ser esto:

Me entendió usted a la perfección. Muchisimas gracias Maestro. Solucionado el tema y espero le pueda servir a otras personas que tengan la misma traba que yo tenía.