Copiare valori di celle excel a seconda della scelta da un menù a tendina

Question

Buongiorno.

Ho questa nuova necessità:

In un mio file exel ho una colonna dove nelle celle vi è un menù a tendna con doppia scelta.

Avrei l'esigenza che a seconda di quello che scelgo dal menù a tendina mil sistema in automatico mi copii i valori di alcune celle in altre celle della stessa riga dove ho fatto la scelta dal menù a tendina.

Esempio:

il menù a tendina si trova nelle colonna I riga 5 e le scelte sono "INSTALLATO" e "NON INSTALLATO"

nel caso io scelga "INSTALLATO" vorrei che il sistema mi copiasse il contenuto della cella G5 in K5 e mi valorizzasse il contenuto della cella L5 scrivendoci "Da Testare"

e così dovrebbe succedere di conseguenza su ogni riga dove scegliesi dal menù atendina  il valore "INSTALLATO"

NB: le righe che mi interessano vanno dalla 5 all 34.

Spero di essere stato abbastanza chiaro.

Rimango in attesa e ringrazio anticipatamente.

Max

Answer 1

Prova

---

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim a As String

    If Target.Column = 14 Then

        Select Case UCase(Target.Value)

            Case Is = ""

                Exit Sub

            Case "SI"

        Set wk = Workbooks.Open("Y:\Giro librerie\2 - INSTALL RPR - PRO\NEW ITER" _

                    & "Comunicazioni a Utenti - Installazione PATCH.xlsx")

                 Set sh = wk.Worksheets("COMUNICAZIONE")

                 With sh

                    lRiga = .Range("A" & .Rows.Count).End(xlUp).Row + 1

                    .Range("A" & lRiga).Value = Me.Range("C" & Target.Row).Value

                    lRiga = .Range("B" & .Rows.Count).End(xlUp).Row + 1

                    .Range("B" & lRiga).Value = Me.Range("A" & Target.Row).Value

                    lRiga = .Range("C" & .Rows.Count).End(xlUp).Row + 1

                    .Range("C" & lRiga).Value = Me.Range("B" & Target.Row).Value

                 End With

        End Select

    ElseIf Target.Column = 1 Then

        Target.Offset(0, 5).Value = Date

        Target.Offset(0, 8).Value = "NON INSTALLATO"

    ElseIf Target.Column = 9 Then

        If Not Intersect(Target, Me.Range("I5:I34")) Is Nothing Then

            If Not Target.Count > 1 Then

                Select Case UCase(Target.Value)

                    Case Is = "INSTALLATO"

                        Target.Offset(0, 2).Value = Target.Offset(0, -2).Value

                        Target.Offset(0, 3).Value = "Da Testare"

                    Case Is = "NON INSTALLATO"

                        'Non faccio nulla

                    Case Else

                        'Non faccio nulla

                End Select

            End If

        End If

    End If

End Sub

---

David

Answer 2

Perfetto!!!!

Grazie mille!

Massimo

Answer 3

Grazie mille ma ti chiedo gentilmente se riesci ad integrarmelo al mio codice già esistente:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim a As String

    If Target.Column = 14 Then

        Select Case UCase(Target.Value)

            Case Is = ""

                Exit Sub

            Case "SI"

        Set wk = Workbooks.Open("Y:\Giro librerie\2 - INSTALL RPR - PRO\NEW ITER" _

                    & "Comunicazioni a Utenti - Installazione PATCH.xlsx")

                 Set sh = wk.Worksheets("COMUNICAZIONE")

                 With sh

                    lRiga = .Range("A" & .Rows.Count).End(xlUp).Row + 1

                    .Range("A" & lRiga).Value = Me.Range("C" & Target.Row).Value

                    lRiga = .Range("B" & .Rows.Count).End(xlUp).Row + 1

                    .Range("B" & lRiga).Value = Me.Range("A" & Target.Row).Value

                    lRiga = .Range("C" & .Rows.Count).End(xlUp).Row + 1

                    .Range("C" & lRiga).Value = Me.Range("B" & Target.Row).Value

                 End With

        End Select

    ElseIf Target.Column = 1 Then

        Target.Offset(0, 5).Value = Date

        Target.Offset(0, 8).Value = "NON INSTALLATO"

    End If

End Sub

NB: se scelgo NON INSTALLATO non deve fare nulla!

Grazie ancora

Answer 4

Ciao Max,

da copiare nel modulo di codice del tuo foglio

---

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Me.Range("I5:I34")) Is Nothing Then

        If Target.Count > 1 Then Exit Sub

        Select Case UCase(Target.Value)

            Case Is = "INSTALLATO"

                Target.Offset(0, 2).Value = Target.Offset(0, -2).Value

                Target.Offset(0, 3).Value = "Da Testare"

            Case Is = "NON INSTALLATO"

                'Cosa Faccio?!!

            Case Else

                'Non faccio nulla

        End Select

    End If

End Sub

---

David