Necesito una macro para Buscar un valor y al hallarlo pegue datos en las tres columnas siguientes

Necesito una macro para Buscar un valor (Buscar en columna A) y al hallarlo, pegue datos en las celdas del costado de las tres columnas siguientes (Columna B, C y D). Me explico, tengo un formulario (ya realizado) con cuatro TextBox y un CommandButton. TextBox1 (N° Pedido), TextBox2 (GR Madre), TextBox3 (GR Hija), TextBox4 (Peso) y CommandButton1 (Ingresar datos). La idea es que al presionar "Ingresar datos" se pongan los datos en la columna que le corresponda de acuerdo al "N° Pedido" hallado (TextBox1). Adjunto código fuente de lo que ya he desarrollado y hasta ahí va todo bien.

Agradezco de antemano por su apoyo. Saludos cordiales.

Sub Borrar_BD()
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
End Sub
Sub Maximo()
'Elimina primera fila
Rows("1:1").Select
Selection.Delete Shift:=xlUp
'Separa todas las celdas combinadas
Range("A1:AZ50000").UnMerge
'Elimina la ultima fila (Contiene fecha y datos que distorsionan BD)
Dim FilaEliminar As Long
FilaEliminar = ActiveSheet.Cells(65536, 1).End(xlUp).Row
ActiveSheet.Cells(FilaEliminar, 1).EntireRow.Delete Shift:=xlUp
'Elimina columnas en blanco
Columns("Z:Z").Select
Selection.Delete Shift:=xlToLeft
Columns("AS:AS").Select
Selection.Delete Shift:=xlToLeft
Columns("AT:AT").Select
Selection.Delete Shift:=xlToLeft
'Inserta columnas
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Select
ActiveCell.FormulaR1C1 = "GR Madre"
Range("C1").Select
ActiveCell.FormulaR1C1 = "GR Hija"
Range("D1").Select
ActiveCell.FormulaR1C1 = "PESO"
'Ordena tamaño de columnas
Cells.Select
Cells.EntireColumn.AutoFit
'Cursor en celda de inicio
Range("A1").Select
'Aparecer formulario
UserForm.Show
End Sub

2

2 respuestas

Respuesta
2

Te anexo el código para el botón de tu form, para ingresar los datos:

Private Sub CommandButton1_Click()
'Por Dante Amor
'Ingresar datos
    pedido = TextBox1.Value
    If pedido = "" Then
        MsgBox "Debes capturar un número de pedido"
        TextBox1.SetFocus
        Exit Sub
    End If
    If IsNumeric(pedido) Then pedido = Val(pedido)
    Set h = Sheets("Report")
    Set b = h.Columns("A").Find(pedido, lookat:=xlWhole)
    If Not b Is Nothing Then
        h.Cells(b.Row, "B") = TextBox2.Value
        h.Cells(b.Row, "C") = TextBox3.Value
        h.Cells(b.Row, "D") = TextBox4.Value
        MsgBox "Datos ingresados"
    Else
        MsgBox "El pedido no existe"
        TextBox1.SetFocus
    End If
End Sub

.

.

¡Gracias! Funcionó a la perfección.

Sin embargo solo ingresa los datos en la primera fila que encuentra y no en la consecutiva que también tiene el mismo numero de pedido. favor tu enseñanza con ello.

Finalmente, como hago para borrar los TextBox después de haber ingresados los Datos.

En tu imagen los número de pedido se ven únicos, quieres decir que vas a tener varias filas con el mismo número de pedido, si es así, entonces utiliza los siguiente:

Private Sub CommandButton1_Click()
'Por Dante Amor
'Ingresar datos
    pedido = TextBox1.Value
    If pedido = "" Then
        MsgBox "Debes capturar un número de pedido"
        TextBox1.SetFocus
        Exit Sub
    End If
    If IsNumeric(pedido) Then pedido = Val(pedido)
    Set h = Sheets("Report")
    Set r = h.Columns("A")
    Set b = r.Find(pedido, LookAt:=xlWhole)
    If Not b Is Nothing Then
        celda = b.Address
        Do
            'detalle
            h.Cells(b.Row, "B") = TextBox2.Value
            h.Cells(b.Row, "C") = TextBox3.Value
            h.Cells(b.Row, "D") = TextBox4.Value
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> celda
        MsgBox "Datos ingresados"
        TextBox1.Value = ""
        TextBox2.Value = ""
        TextBox3.Value = ""
        TextBox4.Value = ""
        TextBox1.SetFocus
    Else
        MsgBox "El pedido no existe"
        TextBox1.SetFocus
    End If
End Sub

sal u dos

Respuesta
2

Prueba esta macro, conforme tecleas los datos en los textbox se van capturando

Private Sub TextBox1_AfterUpdate()
Set DATOS = Range("A1").CurrentRegion
With DATOS
    PEDIDO = Val(TextBox1.Text)
    FILAS = .Rows.Count:  COL = .Columns.Count
    Set DATOS = .Resize(FILAS, 4)
    FILA = WorksheetFunction.Match(PEDIDO, .Columns(1), 0)
    Set PDATOS = DATOS.Rows(FILA)
        With PDATOS
            .Select
            .Name = "REGISTRO"
        End With
End With
End Sub
Private Sub TextBox2_AfterUpdate()
Range("REGISTRO")(2) = TextBox2.Text
End Sub
Private Sub TextBox3_AfterUpdate()
Range("REGISTRO")(3) = TextBox3.Text
End Sub
Private Sub TextBox4_AfterUpdate()
Range("REGISTRO")(4) = TextBox4.Text
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas