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""))"
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