INSERIMENTO RIGA AUTOMATICAMENTE SU PIù FOGLI DI LAVORO

Question

Buongiorno, ho 3 tabelle su Excel nello stesso file ma in fogli diversi (1 tabella x ogni foglio). Tutte e tre le tabelle contengono nella prima colonna gli stessi dati, poi cambiano i dati nelle altre colonne. Vorrei sapere se è possibile quando inserisco una nuova riga su uno dei fogli, che venga inserita automaticamente negli altri due... e come faccio?? Semplificherebbe molto il mio lavoro :) Vi ringrazio!!!

Answer 1

Ciao Priscilla,

Buongiorno, ho 3 tabelle su Excel nello stesso file ma in fogli diversi (1 tabella x ogni foglio). Tutte e tre le tabelle contengono nella prima colonna gli stessi dati, poi cambiano i dati nelle altre colonne. Vorrei sapere se è possibile quando inserisco una nuova riga su uno dei fogli, che venga inserita automaticamente negli altri due... e come faccio?? Semplificherebbe molto il mio lavoro :) 

Sarebbe utile sapere di più sulle tre tabelle e avere un file di esempio.

Tuttavia, come punto di partenza, prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Ctrl+R per accedere alla finestra Project Explorer ('Gestione progetti')
• Fai doppio clic sul modulo ThisWorkbook (Questa_cartella_di_Lavoro) del file
• Incolla il seguente codice

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

Option Explicit

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

Private Sub Workbook_SheetActivate(ByVal SH As Object)

    Dim aSH As Worksheet, bSH As Worksheet

    Dim Rng As Range, Rng2 As Range, rCell As Range

    Dim sFoglioAggiornato As String

    Dim arrFogli As Variant, arrRighe(1 To 2) As Variant

    Dim Res As Variant, Res2 As Variant

    Dim iMax As Long, LRow As Long

    Const sFogli As String = _

          "Settimana1,Settimana2,Settimana3"                  '<<=== Modifica

    Const sPrimacolonnaTabelle As String = "A"            '<<=== Modifica

    arrFogli = Split(sFogli, ",")

    Res = Application.Match(SH.Name, arrFogli, 0)

    If Not IsError(Res) Then

        For Each aSH In Me.Sheets(arrFogli)

            With aSH

                LRow = LastRow(aSH, .Columns(sPrimacolonnaTabelle))

                If LRow > iMax Then

                    iMax = LRow

                    With aSH

                        Set Rng = .Cells(1, sPrimacolonnaTabelle).Resize(LRow)

                        sFoglioAggiornato = .Name

                    End With

                End If

            End With

        Next aSH

        On Error GoTo XIT

        With Application

            .ScreenUpdating = False

            .EnableEvents = False

        End With

        Rng.Copy

        For Each bSH In Me.Sheets(arrFogli)

            With bSH

                If .Name <> sFoglioAggiornato Then

                .Select

                Set Rng2 = Selection

                 Set rCell = ActiveCell

                    .Range("A1").PasteSpecial _

                            Paste:=xlPasteAll, _

                            Operation:=xlNone, _

                            SkipBlanks:=False, _

                            Transpose:=False

                            Rng2.Select

                            rCell.Activate

                End If

            End With

        Next bSH

    End If

    SH.Select

XIT:

    With Application

        .EnableEvents = True

        .CutCopyMode = False

        .ScreenUpdating = True

    End With

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 Priscilla20180202.xlsm

===

Regards,

Norman