Macro para copiar una celda en función de otra

A ver si consigo explicar lo que quiero.

En una hoja tengo los datos de un albarán que los copio a una hoja de registro cada vez que imprimo. Esta parte la tengo en código, pero quiero implementar una parte que no se como.

En el albarán tengo para escoger 5 productos desde un desplegable. En la hoja de registro tengo 5 columnas con cada producto. Lo que quiero es que me copie una casilla (kilos) en la columna correspondiente en función de si pone un producto o otro:

Ejemplo: productos (rojo, verde, azul, amarillo, blanco). Si en el albarán tengo elegido el verde, que se copie la casilla kilos en la columna correspondiente a verde.

Este es le código que tengo para copiar lo demás:

respuesta = MsgBox("¿Desea guardar albaran en el registro?", vbYesNoCancel)
Select Case respuesta
Case vbYes
Dim filalibre As Integer
filalibre = Sheets("REGISTRO").Range("A65536").End(xlUp).Row + 1
Sheets("ALBARANES").Select
ActiveSheet.Range("A18").Select
Sheets("REGISTRO").Cells(filalibre, 1) = ActiveCell
ActiveSheet.Range("I18").Select
Sheets("REGISTRO").Cells(filalibre, 2) = ActiveCell
ActiveSheet.Range("S15").Select
Sheets("REGISTRO").Cells(filalibre, 3) = ActiveCell
ActiveSheet.Range("a22").Select
Sheets("REGISTRO").Cells(filalibre, 12) = ActiveCell
ActiveSheet.Range("ab22").Select
Sheets("REGISTRO").Cells(filalibre, 13) = ActiveCell
ActiveSheet.Range("AE22").Select
Sheets("REGISTRO").Cells(filalibre, 14) = ActiveCell
ActiveSheet.Range("E22").Select
Sheets("REGISTRO").Cells(filalibre, 8) = ActiveCell
Sheets("REGISTRO").Cells(filalibre, 15) = "=UPPER(TEXT(RC[1],""MMMM""))"

1 Respuesta

Respuesta
2

Indicame a partir de que col empiezan las 5 para los kilos.

Además voy a aligerar un poco tu código. No es necesario que te posiciones en las celdas para copiarlas. Podrías escribirlo así:

Sheets("REGISTRO").Cells(filalibre, 1) = ActiveSheet.Range("A18")
Sheets("REGISTRO").Cells(filalibre, 2) =ActiveSheet. Range("I18")

Comentame los nombres de los prod y en que col van. No valores aun.

Buenas Elsa, gracias por la ayuda en simplificación del código.

Ayer conseguí hacer lo que quería buscando y copiando código, pero como yo no entiendo a penas nada de código seguramente se puede abreviar. Te envío la parte de código que tengo con todo, actualizado con tu abreviación:

respuesta = MsgBox("¿Desea guardar albaran en el registro?", vbYesNoCancel)
Select Case respuesta
Case vbYes
Dim filalibre As Integer
filalibre = Sheets("REGISTRO").Range("A65536").End(xlUp).Row + 1
Sheets("ALBARANES").Select
Sheets("REGISTRO").Cells(filalibre, 1) = ActiveSheet.Range("A19")
Sheets("REGISTRO").Cells(filalibre, 2) = ActiveSheet.Range("I19")
Sheets("REGISTRO").Cells(filalibre, 3) = ActiveSheet.Range("S15")
Sheets("REGISTRO").Cells(filalibre, 13) = ActiveSheet.Range("A22")
Sheets("REGISTRO").Cells(filalibre, 14) = ActiveSheet.Range("AB22")
Sheets("REGISTRO").Cells(filalibre, 15) = ActiveSheet.Range("AE22")
If ActiveSheet.Range("E22").Value = "ALEVINES" Then
Sheets("REGISTRO").Cells(filalibre, 4) = ActiveSheet.Range("A22")
Else
If ActiveSheet.Range("E22").Value = "TRUCHA RACION" Then
Sheets("REGISTRO").Cells(filalibre, 5) = ActiveSheet.Range("A22")
Else
If ActiveSheet.Range("E22").Value = "TRUCHA/FILETE" Then
Sheets("REGISTRO").Cells(filalibre, 6) = ActiveSheet.Range("A22")
Else
If ActiveSheet.Range("E22").Value = "TRUCHA REPOBLACION" Then
Sheets("REGISTRO").Cells(filalibre, 7) = ActiveSheet.Range("A22")
Else
If ActiveSheet.Range("E22").Value = "TRUCHA EVISCERADA" Then
Sheets("REGISTRO").Cells(filalibre, 8) = ActiveSheet.Range("A22")
Else
If ActiveSheet.Range("E22").Value = "FILETE" Then
Sheets("REGISTRO").Cells(filalibre, 9) = ActiveSheet.Range("A22")
Else
If ActiveSheet.Range("E22").Value = "TRUCHITA" Then
Sheets("REGISTRO").Cells(filalibre, 10) = ActiveSheet.Range("A22")
Else
If ActiveSheet.Range("E22").Value = "HUEVA CONGELADA" Then
Sheets("REGISTRO").Cells(filalibre, 11) = ActiveSheet.Range("A22")
Else
If ActiveSheet.Range("E22").Value = "HUEVA FRESCA" Then
Sheets("REGISTRO").Cells(filalibre, 12) = ActiveSheet.Range("A22")
End If
End If
End If
End If
End If
End If
End If
End If
End If
Sheets("REGISTRO").Cells(filalibre, 16) = "=UPPER(TEXT(RC[-14],""MMMM""))"
Case vbNo
'no copia el registro y sigue con la impresion
Case vbCancel
'se cancela el registro y la impresion
Cancel = True
Exit Sub
End Select

No está mal si resuelve el tema, pero vamos a mejorarla un poco. Considerando que son muchas las opciones es mejor utilizar SELECT CASE.

respuesta = MsgBox("¿Desea guardar albaran en el registro?", vbYesNoCancel)
Select Case respuesta
Case vbYes
Dim filalibre As Integer
Dim colx As Integer
filalibre = Sheets("REGISTRO").Range("A65536").End(xlUp).Row + 1
Sheets("ALBARANES").Select
Sheets("REGISTRO").Cells(filalibre, 1) = ActiveSheet.Range("A19")
Sheets("REGISTRO").Cells(filalibre, 2) = ActiveSheet.Range("I19")
Sheets("REGISTRO").Cells(filalibre, 3) = ActiveSheet.Range("S15")
Sheets("REGISTRO").Cells(filalibre, 13) = ActiveSheet.Range("A22")   'atención va el mismo dato
Sheets("REGISTRO").Cells(filalibre, 14) = ActiveSheet.Range("AB22")
Sheets("REGISTRO").Cells(filalibre, 15) = ActiveSheet.Range("AE22")
Select Case ActiveSheet.Range("E22").Value
    Case Is = "ALEVINES"
        colx = 4
    Case Is = "TRUCHA RACION"
        colx = 5
    Case Is = "TRUCHA/FILETE"
        colx = 6
    Case Is = "TRUCHA REPOBLACION"
        colx = 7
    Case Is = "TRUCHA EVISCERADA"
        colx = 8
    Case Is = "FILETE"
        colx = 9
    Case Is = "TRUCHITA"
        colx = 10
    Case Is = "HUEVA CONGELADA"
        colx = 11
    Case Is = "HUEVA FRESCA"
        colx = 12
End Select
Sheets("REGISTRO").Cells(filalibre, colx) = ActiveSheet.Range("A22")
Sheets("REGISTRO").Cells(filalibre, 16) = "=UPPER(TEXT(RC[-14],""MMMM""))"
Case vbNo
'no copia el registro y sigue con la impresion
Case vbCancel
'se cancela el registro y la impresion
Cancel = True
Exit Sub
End Select

Noto que en fila 13 pasás la misma celda A22.... quizás debas revisarlo.

Sdos

Elsa

http://aplicaexcel.galeon.com/macros.htm

¡Gracias! 

Muchas gracias Elsa.

Yo esto de los macros no tengo ni idea y voy copiando y deduciendo segun necesito.

Tu codigo es mucho mas breve y claro, por lo que usare el tuyo.

Respecto a la casilla repetida soy consciente de ello. La necesito para otras operaciones por lo que la copio 2 veces.

Gracias de nuevo

Entonces no olvides valorar desde el desplegable que está al final.

Sdos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Realizar reportes en excel

De nuevo por aca estoy solicitando de su valiosa ayuda. Tengo una hoja llamada registros, en donde en b9(fecha); c9(articulo);c10(entradas) d10(salidas). Tengo un formulario llamado reportes en donde deseo ingresar el nombre del articulo y que me...
1 respuesta

Unir Userform

Me presento soy Israel, si me puedes ayudar (formulario para cargar una base de datos) estoy modificando una guía de despacho que tengo me me ha servido muchísimo, esta se divide en dos Userform, la primera parte consta de 22 (entre combobox y...
1 respuesta

Ejecutar macro según el valor de la celda

Que tal necesito de su valiosa ayuda tengo que ejecutar una macro en automático esto depende del valor de la celda. Estoy utilizando la siguiente macro: Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$S$1" And...
1 respuesta

Buscar datos y según sea el dato encontrado pegarlo en hojas distintas.

Buscando en los foros encontré la siguiente macro; filalibre = Sheets("hoja2").Range("a65000").End(xlUp).Row + 1 dato = InputBox("que dato buscamos???") If dato = "" Then Exit Sub Set buscado = ActiveSheet.Range("a1:a" &...
2 respuestas

Vlookup o BuscarV en VBA Excel

Estoy Tratando de Crear unos Vlookup en unos cuadros de texto que cuando se seleccione un código por ejemplo, me traiga el nombre y el lugar de trabajo.
1 respuesta

Copiar datos a hojas desde formulario con 2 paginas

Tengo un UserForm que quiero utilizar como formulario, para introducir datos a dos hojas distintas (Hoja1 y Hoja2); de tal manera que los datos que introduzca en los distintos TextBox y ComboBox, de la "Page1" del UserForm se copien en la Hoja1; y...
1 respuesta

Macro que copia celdas sin repetir los datos copiados

Hará cosa de dos meses os consultaba una duda sobre una macro que me copiase celdas de una hoja a otra en determinadas columnas (la pregunta era: "Crear macro que copie celdas si cumplen una condición".) Me funcionó a la perfección, pero usándola me...
1 respuesta

Optimizar macro

La verdad soy nuevo con las macros asi que no se mucho de códigos, pero quisiera poder optimizar el siguiente código., ya que, si realiza la tarea que necesito pero me parece que puede optimizarse; lo que más necesito es que cuando ya tengo muchos...
2 respuestas