Copiare automaticamente una riga da un foglio ad un altro

Question

Buon pomeriggio, sono Camilla, sono nuova del forum, ho provato a leggere e utilizzare quanto è stato creato in precedenza ed adattarlo al mio scopo, ma senza successo, probabilmente perché sono incapace io, Vi espongo il mio quesito:

ho un foglio generico (GENERALE) dove raccolgo le anagrafiche dei miei atleti e dei loro genitori, in una colonna di questo foglio sarà riportata la categoria ad esempio ESORDIENTIC:

vorrei creare un foglio (ESORDIENTIC) in cui vengono copiati in automatico, ogni volta che aggiungo un atleta, (che avrà nella colonna J la dicitura ESORDIENTEC) copiando però solo determinate colonne che contengono ad esempio COGNOME (col A) NOME (col B) data di nascita (col C) scadenza certificato (col D) mail (col E) telefono (col F);

nel file GENERICO si trovano rispettivamente nelle colonne A, B, D, J, T, AB.

Poi dovrei creare dei foglii analoghi (credo sia sufficiente cambiare solo i parametri) per tutte le categorie.

Ringrazio anticipatamente chi vorrà aiutarmi, grazie mille. Camilla

Answer 1

Ciao Camilla,

Benvenuta alla Community!

Buon pomeriggio, sono Camilla, sono nuova del forum, ho provato a leggere e utilizzare quanto è stato creato in precedenza ed adattarlo al mio scopo, ma senza successo, probabilmente perché sono incapace io, Vi espongo il mio quesito:

ho un foglio generico (GENERALE) dove raccolgo le anagrafiche dei miei atleti e dei loro genitori, in una colonna di questo foglio sarà riportata la categoria ad esempio ESORDIENTIC:

vorrei creare un foglio (ESORDIENTIC) in cui vengono copiati in automatico, ogni volta che aggiungo un atleta, (che avrà nella colonna J la dicitura ESORDIENTEC) copiando però solo determinate colonne che contengono ad esempio COGNOME (col A) NOME (col B) data di nascita (col C) scadenza certificato (col D) mail (col E) telefono (col F);

nel file GENERICO si trovano rispettivamente nelle colonne A, B, D, J, T, AB.

Poi dovrei creare dei foglii analoghi (credo sia sufficiente cambiare solo i parametri) per tutte le categorie.

Prova qualcosa del genere:

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

'=========>>

Option Explicit

Option Compare Text

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

Private Sub Worksheet_Activate()

    Dim srcSH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim ArrIn As Variant, arrOut() As Variant, arrTitles As Variant

    Dim LRow As Long

    Dim iCol As Long, jCol As Long, iCtr As Long

    Dim i As Long, j As Long, k As Long

    Dim UB As Long

    Const sFoglio As String = "GENERALE"                            '<<=== Modifica

    Const sColonnaConfronto As String = "J"                        '<<=== Modifica

    Const sColonneDaCopiare As String = "A:F"                    '<<=== Modifica

    Const sParolaConfronto As String = "ESORDIENTIC"       '<<=== Modifica

    Me.UsedRange.Offset(1).ClearContents

    Set srcSH = ThisWorkbook.Sheets(sFoglio)

    With srcSH

        LRow = LastRow(srcSH, .Columns("A:A"))

        Set srcRng = .Range("A2:" & sColonnaConfronto & LRow)

        iCol = .Range(sColonneDaCopiare).Columns.Count

        jCol = .Columns(sColonnaConfronto).Column

    End With

    With srcRng

        ArrIn = .Value

        arrTitles = .Rows(0).Resize(1, iCol).Value

    End With

        UB = UBound(ArrIn)

        ReDim arrOut(1 To UB, 1 To iCol)

        For i = 1 To UB

            If ArrIn(i, jCol) = sParolaConfronto Then

                iCtr = iCtr + 1

                For j = 1 To iCol

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

                Next j

            End If

        Next i

        If CBool(iCtr) Then

            With Me

                .Range("A1").Resize(1, iCol).Value = arrTitles

                .Range("A2").Resize(iCtr, iCol).Value = arrOut

            End With

        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

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

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

Ora, ogni volta che si seleziona il foglio ESORDIENTIC, i dati visualizzati sarranno automaticamente aggiornati.

Potresti scaricare il mio file di prova Camilla20170306.xlsm a:

https://www.dropbox.com/s/gphh1cgpm8ui0m5/Camilla20170306.xlsm?dl=0

===

Regards,

Norman