Come copiare più fogli excel (1.2.3.4....) in un unico foglio (...13) nello stesso file

Anonimo
2018-06-22T09:40:30+00:00

Buongiorno a tutti,

ho necessità di trasferire in automatico i dati di più fogli (1.2.3.4.5....) in un unico foglio (...13) presenti nello stesso file.

I dati nei vari fogli sorgente possono aumentare o diminuire (le righe possono variare ma rimangono invariate le colonne) e in automatico dovrebbe aggiornarsi il foglio Master.

Esiste una formula?

Qualcuno sa dirmi come posso fare?

Microsoft 365 e Office | Excel | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti Nessun commento

Risposta accettata dall'autore della domanda

Anonimo
2018-06-23T00:07:50+00:00

Ciao  Barbara,

in realtà se aggiungo o elimino delle voci funziona benissimo il problema nasce se elimino il contenuto totale di un foglio, mi cancella tutto il contenuto dell' ultimo....

Hai indubbiamente  ragione di indicare che il mio codice non gestirebbe la possibilità, non suggerita da te, di fogli vuoti.

Si può fare qualcosa? 

Scusami se non l' ho scritto nella prima domanda.

Per gestire anche la possibiltà che almeno uno dei tuoi dodicici fogli mensili (?) potesse essere vuoto, nel modulo di codice dietro il foglio Master, prova a sostituire il codice esistente con il seguente adattamento:

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

Option Explicit

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

Private Sub Worksheet_Activate()

    Dim SH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim iRow As Long, jRow As Long

    Dim bFlag As Boolean

    On Error GoTo XIT

        With Application

        .ScreenUpdating = False

        .EnableEvents = False

        .Calculation = xlCalculationManual

        End With

    For Each SH In ThisWorkbook.Worksheets

        With SH

            If .Name <> Me.Name Then

                If Not bFlag Then

                    Me.UsedRange.ClearContents

                    Intersect(.Rows(1), .UsedRange).Copy _

                            Destination:=Me.Range("A1")

                    bFlag = True

                End If

                iRow = LastRow(Me)

                Set destRng = Me.Cells(iRow + 1, "A")

                jRow = LastRow(SH, .Columns("A:A"))

                If jRow > 1 Then

                    Set srcRng = .Range("A2").Resize(jRow - 1, _

                                                     .UsedRange.Columns.Count)

                    srcRng.Copy Destination:=destRng

                End If

            End If

        End With

    Next SH

XIT:

    With Application

        .ScreenUpdating = True

        .EnableEvents = True

        .Calculation = xlCalculationAutomatic

    End With

End Sub

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

===

Regards,

Norman

La risposta è stata utile?

1 persona ha trovato utile questa risposta.
0 commenti Nessun commento

Risposta accettata dall'autore della domanda

Anonimo
2018-06-22T11:40:18+00:00

Ciao Barbara,

ho necessità di trasferire in automatico i dati di più fogli (1.2.3.4.5....) in un unico foglio (...13) presenti nello stesso file.

I dati nei vari fogli sorgente possono aumentare o diminuire (le righe possono variare ma rimangono invariate le colonne) e in automatico dovrebbe aggiornarsi il foglio Master.

Esiste una formula?

Qualcuno sa dirmi come posso fare?

Prova qualcosa del genere:

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

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

Option Explicit

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

Private Sub Worksheet_Activate()

    Dim SH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim iRow As Long, jRow As Long

    Dim bFlag As Boolean

    On Error GoTo XIT

    With Application

    .ScreenUpdating = False

    .EnableEvents = False

    .Calculation = xlCalculationManual

    End With

    For Each SH In ThisWorkbook.Worksheets

        With SH

            If .Name <> Me.Name Then

                If Not bFlag Then

                    Me.UsedRange.ClearContents

                    Intersect(.Rows(1), .UsedRange).Copy _

                            Destination:=Me.Range("A1")

                    bFlag = True

                End If

                iRow = LastRow(Me)

                Set destRng = Me.Cells(iRow + 1, "A")

                jRow = LastRow(SH, .Columns("A:A"))

                Set srcRng = .Range("A2").Resize(jRow - 1, _

                                                 .UsedRange.Columns.Count)

                srcRng.Copy Destination:=destRng

            End If

        End With

    Next SH

XIT:

      With Application

    .ScreenUpdating = True

    .EnableEvents = True

    .Calculation = xlCalculationAutomatic

    End With

End Sub

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

  • Alt+IMper 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, _

                        Optional sPassword As String)

    Dim bProtected As Boolean

    With SH

        If rng Is Nothing Then

            Set rng = .Cells

        End If

        bProtected = .ProtectContents = True

        If bProtected Then

            Application.ScreenUpdating = False

            .Unprotect Password:=sPassword

        End If

    End With

    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

    If bProtected Then

        SH.Protect Password:=sPassword, _

                   UserInterfaceOnly:=True

    End If

    Application.ScreenUpdating = True

End Function

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

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

===

Regards,

Norman

La risposta è stata utile?

0 commenti Nessun commento

9 risposte aggiuntive

Ordina per: Più utili
  1. Anonimo
    2018-06-22T12:39:58+00:00

    Norman,

    in realtà se aggiungo o elimino delle voci funziona benissimo il problema nasce se elimino il contenuto totale di un foglio, mi cancella tutto il contenuto dell' ultimo....

    Si può fare qualcosa? 

    Scusami se non l' ho scritto nella prima domanda.

    Grazie mille

    La risposta è stata utile?

    0 commenti Nessun commento
  2. Anonimo
    2018-06-22T12:23:21+00:00

    Ciao Norman,

    spettacolo :) funziona....se aggiungo....aggiunge :) non mi sembra vero :) :) :)

    Però, ho provato ad annullare il contenuto di un foglio (1) e mi elimina tutto il contenuto del foglio appena creato (13)....

    E' possibile far aggiornare l' ultimo foglio se aggiungo o elimino delle voci????

    Scusami....potevo scriverlo dall' inizio....

    Attendo tue :)

    La risposta è stata utile?

    0 commenti Nessun commento
  3. Anonimo
    2018-06-22T11:09:34+00:00

    Ciao Barbara,

    siamo qui per aiutarti!

    Se desideri spostare o copiare dati di uno o più foglio di lavoro in un altro foglio Excel, ti consiglio di dare uno sguardo aquesto articolo nel quale troverai tutte le indicazioni e step da seguire per procedere con questa opzione! Per impostare la copia automatica, dovresti inserire una macro all'interno del documento, per questo ti cosniglierei di postare la tua domanda sul forum di msdn, dove in team di esperti sarà pronto a fornirti tutta l'assistenza necessaria.

    Spero questo possa esserti d'aiuto.

    Tienici aggiornati e non esitare a contattarci per ogni eventuale dubbio o domanda.

    A presto,

    Claudia

    La risposta è stata utile?

    0 commenti Nessun commento