Tabelle collegate a foglio master

Question

Buongiorno,

ho un file excel strutturato come segue

foglio master contenente un elenco di  n righe con N titoli colonna

titolo1	titolo2	titolo3	.......	titoloN

vorrei replicare negli altri fogli di lavoro, solo alcune delle colonne del foglio master

Foglio 1

titolo1	titolo2

Foglio 2

titolo3	titolo4

Se però cancello le righe nel foglio master, si devono aggiornare anche gli altri fogli

Grazie

TT

Answer 1

Ciao TT_968,

ho un file excel strutturato come segue

foglio master contenente un elenco di  n righe con N titoli colonna

titolo1	titolo2	titolo3	.......	titoloN

vorrei replicare negli altri fogli di lavoro, solo alcune delle colonne del foglio master

Foglio 1

titolo1	titolo2

Foglio 2

titolo3	titolo4

Se però cancello le righe nel foglio master, si devono aggiornare anche gli altri fogli

Prova qualcosa del genere:

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

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

Option Explicit

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

Private Sub Worksheet_Activate()

    Const sColonneDaCopiare As String = "A:A,B:B"                   '<<=== Modifica

    Call AggiornaMi(Me, sColonneDaCopiare)

End Sub

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

• Alt+Q
• Fai clic dx sulla linguetta del Foglio3
• Seleziona l'opzione Visualizza Codicedal****menu contestuale risultante
• Incolla il seguente codice:

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

Option Explicit

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

Private Sub Worksheet_Activate()

    Const sColonneDaCopiare As String = "C:C,D:E"                  '<<=== Modifica

    Call AggiornaMi(Me, sColonneDaCopiare)

End Sub

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

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

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

Option Explicit

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

Public Sub AggiornaMi(aSH As Worksheet, myCols As String)

    Dim WB As Workbook

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim srcRng As Range, destRng As Range, copyRng As Range

    Dim LRow As Long

    Dim CalcMode As Long

    Const sFoglioMaster As String = "Master"                          '<<=== Modifica

    Const sColonneSorgent As String = "A:E"                           '<<=== Modifica

    Set WB = ThisWorkbook

    Set srcSH = WB.Sheets(sFoglioMaster)

    Set destSH = aSH

    With srcSH

        LRow = LastRow(srcSH, .Columns(sColonneSorgent))

        Set srcRng = .Range(sColonneSorgent).Resize(LRow)

        Set copyRng = Intersect(srcRng, .Range(myCols))

    End With

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

    End With

    With destSH

        .Columns(1).Resize(copyRng.Columns.Count).ClearContents

        copyRng.Copy Destination:=.Range("A1")

    End With

XIT:

    With Application

        .Calculation = CalcMode

        .ScreenUpdating = True

    End With

End Sub

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

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

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

https://www.dropbox.com/s/yxx55a1wuc5bad0/TT20160927.xlsm?dl=0

===

Regards,

Norman