Anónimo
Copiar una fila completa según ID
Hola Vorkosigan me podrías ayudar tengo una un problema y si no es mucha la molestia aquí esta
El primero un macro ayude a buscar un ID en la hoja "PRODUCTOS" en la columna A2 en adelante y si no existe el ID que me de un mensaje diciéndome "El Articulo No Existe en Bodega"
El Segundo un macro que me busque un FOLIO (celda B7 del libro BÚSQUEDA FOLIO) en la hoja "HISTORIAL" y me copie la Fila completa a la fila A10 del libro BÚSQUEDA FOLIO
después de esto yo modifico los datos que por error haya colocado mal o que alguien me devuelva algo o por motivo modifico los datos del folio determinado entonces la macro que necesito es que me busque ahora el folio en el libro "HISTORIAL" y me sustituya la fila completa
de antemano muchas gracias,
El primero un macro ayude a buscar un ID en la hoja "PRODUCTOS" en la columna A2 en adelante y si no existe el ID que me de un mensaje diciéndome "El Articulo No Existe en Bodega"
El Segundo un macro que me busque un FOLIO (celda B7 del libro BÚSQUEDA FOLIO) en la hoja "HISTORIAL" y me copie la Fila completa a la fila A10 del libro BÚSQUEDA FOLIO
después de esto yo modifico los datos que por error haya colocado mal o que alguien me devuelva algo o por motivo modifico los datos del folio determinado entonces la macro que necesito es que me busque ahora el folio en el libro "HISTORIAL" y me sustituya la fila completa
de antemano muchas gracias,
Respuesta de vorkosigan
1
¿Cómo estás?
Para la primera cuestión prueba este código; está testeado para Excel 2003:
Sub BuscarProducto()
Dim ID As String
Dim i, FilaInicio, ColumnaInicio As Integer
Dim fila, col As Integer
ID = Application.InputBox("Introduzca un ID válido")
FilaInicio = 2
ColumnaInicio = 1
fila = FilaInicio
col = ColumnaInicio
While Cells(fila, col).Value <> ""
If Cells(fila, col).Value = ID Then
tmp = MsgBox("Articulo encontrado en Bodega", , "Información")
Exit Sub
End If
fila = fila + 1
Wend
tmp = MsgBox("El Articulo No Existe en Bodega",, "¡Error!")
End Sub
Para el segundo script prueba lo siguiente. Debes pegarlo en Workbook o bien en un nuevo módulo (no funcionará a nivel de Sheet):
Sub BuscarFolio()
Dim IDFolio, rango As String
Dim i, FilaInicio, ColumnaInicio As Integer
Dim fila, col As Integer
Sheets("busqueda folio").Select
IDFolio = Cells(7, 2).Value
FilaInicio = 1
ColumnaInicio = 1
fila = FilaInicio
col = ColumnaInicio
While Worksheets("historia").Cells(fila, col).Value <> ""
If Worksheets("historia").Cells(fila, col).Value = IDFolio Then
tmp = MsgBox("Folio encontrado", , "Información")
'formula de conversion de fila a formato de rango
rango = Mid$(Str$(fila), 2) & ":" & Mid$(Str$(fila), 2)
'copia el folio de la hoja "historial"
Sheets("historia").Select
Rows(rango).Select
Selection.Copy
'pega el folio en la hoja "busqueda folio"
Sheets("busqueda folio").Select
Rows("10:10").Select
ActiveSheet.Paste
Exit Sub
End If
fila = fila + 1
Wend
tmp = MsgBox("El Folio No Existe", , "¡Error!")
End Sub
Para la primera cuestión prueba este código; está testeado para Excel 2003:
Sub BuscarProducto()
Dim ID As String
Dim i, FilaInicio, ColumnaInicio As Integer
Dim fila, col As Integer
ID = Application.InputBox("Introduzca un ID válido")
FilaInicio = 2
ColumnaInicio = 1
fila = FilaInicio
col = ColumnaInicio
While Cells(fila, col).Value <> ""
If Cells(fila, col).Value = ID Then
tmp = MsgBox("Articulo encontrado en Bodega", , "Información")
Exit Sub
End If
fila = fila + 1
Wend
tmp = MsgBox("El Articulo No Existe en Bodega",, "¡Error!")
End Sub
Para el segundo script prueba lo siguiente. Debes pegarlo en Workbook o bien en un nuevo módulo (no funcionará a nivel de Sheet):
Sub BuscarFolio()
Dim IDFolio, rango As String
Dim i, FilaInicio, ColumnaInicio As Integer
Dim fila, col As Integer
Sheets("busqueda folio").Select
IDFolio = Cells(7, 2).Value
FilaInicio = 1
ColumnaInicio = 1
fila = FilaInicio
col = ColumnaInicio
While Worksheets("historia").Cells(fila, col).Value <> ""
If Worksheets("historia").Cells(fila, col).Value = IDFolio Then
tmp = MsgBox("Folio encontrado", , "Información")
'formula de conversion de fila a formato de rango
rango = Mid$(Str$(fila), 2) & ":" & Mid$(Str$(fila), 2)
'copia el folio de la hoja "historial"
Sheets("historia").Select
Rows(rango).Select
Selection.Copy
'pega el folio en la hoja "busqueda folio"
Sheets("busqueda folio").Select
Rows("10:10").Select
ActiveSheet.Paste
Exit Sub
End If
fila = fila + 1
Wend
tmp = MsgBox("El Folio No Existe", , "¡Error!")
End Sub