formula per copiare riga excel in base a condizione

Question

Salve,

ho creato un foglio excel per gestire le consegne a domicilio. In una delle colonne del foglio, ho inserito un campo con elenco con i nome dei fattorini e riga per riga seleziono il nome della persona a cui affidare la consegna. Vorrei capire come impostare una formula per fare in modo che quando nel campo fattorino io seleziono dall'elenco a discesa il nome A, la riga venga copiata nel foglio "CONSEGNE A", se selezione il nome B, la riga venga copiata nel foglio "CONSEGNE B" e così via.

Grazie a tutti per l'aiuto!

Answer 1

Ciao Federico,

Adesso ho capito perche il file non funziona!

Ti allego un nuovo file di prova

https://1drv.ms/x/s!ApJytEL3u81Ngbxkgf0U6-06fgZ4fg?e=AtNDVF

La colonna che comanda la regola del nome è quella tra la modalità di consegna e l'orario. Quindi quando io in quella colonna seleziono il nome della persona a cui la consegna è affidata, la riga deve essere copiata nel rispettivo foglio.

Spero di essere riuscito a spiegarmi e spero che questo possa essere fatto visto che quelle sono celle con elenco.

Prova qualcosa del genere:

:

• Fai clic dx sulla linguetta del foglio In Corso
• Seleziona l'opzione Visualizza Codice dal **** menu contestuale risultante
• Incolla il seguente codice:

'========>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim SH As Worksheet

    Dim Rng As Range, rCell As Range

    Dim sFoglio As String

    Const sPrefisso As String = "In corso "

    Set Rng = Intersect(Me.Columns("B"), Target)

    If Not Rng Is Nothing Then

        For Each rCell In Rng.Cells

            With ThisWorkbook

                sFoglio = rCell.Value

                If Not SheetExists(sPrefisso & sFoglio) Then

                    Application.ScreenUpdating = False

                    Set SH = ThisWorkbook.Sheets.Add(After:=.Sheets(.Sheets.Count))

                    SH.Name = sPrefisso & sFoglio

                    Me.Rows("1:2").Copy Destination:=SH.Range("A1")

                    SH.Rows(1).RowHeight = 20.25

                    SH.Rows(2).RowHeight = 33

                    Me.Activate

                    Application.ScreenUpdating = True

                End If

            End With

            Next rCell

    End If

End Sub

'<<=========

• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'========>>

Option Explicit

'--------->>

Public Function LastRow(SH As Worksheet, _

    Optional Rng As Range, _

    Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

        After:=Rng.Cells(1), _

        Lookat:=xlPart, _

        LookIn:=xlFormulas, _

        SearchOrder:=xlByRows, _

        SearchDirection:=xlPrevious, _

        MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'--------->>

Public Function SheetExists(sSheetName As String, _

    Optional ByVal WB As Workbook) As Boolean

    On Error Resume Next

    If WB Is Nothing Then

        Set WB = ThisWorkbook

    End If

    SheetExists = CBool(Len(WB.Sheets(sSheetName).Name))

    On Error GoTo 0

End Function

'<<=========

• Ctrl+R per accedere alla finestra Project Explorer ('Gestione progetti')
• Fai doppio clic sul modulo ThisWorkbook (Questa_cartella_di_Lavoro) del file e incolla il seguente codice:

'========>>

Option Explicit

Option Compare Text

'-------->>

Private Sub Workbook_SheetActivate(ByVal SH As Object)

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim arrIn As Variant, arrOut() As Variant

    Dim sNome As String

    Dim i As Long, j As Long

    Dim icol As Long, iCtr As Long

    Dim LRow As Long

    Const sFoglio_Sorgente As String = "In corso"

    Const sColonne As String = "A:I"

    Const sPrefisso As String = "In corso "

    If SH.Name = Trim(sPrefisso) Then

        Exit Sub

    End If

    Set srcSH = ThisWorkbook.Sheets(sFoglio_Sorgente)

    LRow = LastRow(srcSH)

    icol = SH.Range(sColonne).Columns.Count

    sNome = Replace(SH.Name, sPrefisso, vbNullString)

    Set srcRng = srcSH.Range(sColonne).Resize(LRow - 2).Offset(2)

    arrIn = srcRng.Value

    For i = 1 To UBound(arrIn)

        If arrIn(i, 2) = sNome Then

            iCtr = iCtr + 1

            ReDim Preserve arrOut(1 To icol, 1 To iCtr)

            For j = 1 To icol

                arrOut(j, iCtr) = arrIn(i, j)

            Next j

        End If

        Next i

    SH.UsedRange.Offset(2).ClearContents

    If CBool(iCtr) Then

        SH.Range("A3").Resize(iCtr, icol).Value = Application.Transpose(arrOut)

    End If

End Sub

'<<========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm

Potresti scaricare il mio file di prova Federico2_20200616.xlsm

===

Regards,

Norman

Answer 2

Ciao Federico,

Grazie, ho provato a scaricare il tuo file, attivare la macro ma non funziona. Io seleziono dall'elenco il nome della persona ma la riga non viene copiata. Ho sbagliato qualcosa io?

Come è scritto, il codice richiede che il foglio corrispondente al nome inserito nel foglio InCorso esista già.

Pertanto, ho modificato i nomi su quel fogio e ti chiederei di riscaricare  il mio file di prova Federico20200612.xlsm

Comunque, se desideri che venga creato un nuovo foglio se non esiste già, modificherò di conseguenza il mio codice.

===

Regards,

Norman

Adesso ho capito perche il file non funziona!

Ti allego un nuovo file di prova

https://1drv.ms/x/s!ApJytEL3u81Ngbxkgf0U6-06fgZ4fg?e=AtNDVF

La colonna che comanda la regola del nome è quella tra la modalità di consegna e l'orario. Quindi quando io in quella colonna seleziono il nome della persona a cui la consegna è affidata, la riga deve essere copiata nel rispettivo foglio.

Spero di essere riuscito a spiegarmi e spero che questo possa essere fatto visto che quelle sono celle con elenco.

Grazie!