Se stai gestendo più fogli contemporaneamente e desideri copiare i dati da ciascun foglio in un foglio di lavoro principale, dovresti leggere questo articolo. Useremo la proprietà currentregion del codice VBA per consolidare i dati da tutti i fogli di lavoro in un singolo foglio. Questa proprietà è utile per molte operazioni che espandono automaticamente la selezione per includere l'intera area corrente, come il metodo Formattazione automatica. Questa proprietà non può essere utilizzata in un foglio di lavoro protetto.
La condizione è: ogni foglio deve contenere un formato simile ovvero lo stesso numero di colonne; utilizzando lo stesso formato possiamo avere dati accuratamente uniti.
Nota: questo articolo dimostrerà l'utilizzo del codice VBA; se per qualsiasi motivo il numero di colonne differisce in uno dei fogli, gli interi dati uniti non forniranno un'immagine accurata. Si consiglia vivamente di utilizzare lo stesso numero di colonne. Il codice VBA aggiungerà un nuovo foglio alla cartella di lavoro e quindi copierà e incollerà i dati dopo ogni foglio senza sovrascrivere.
Prendiamo un esempio di 3 fogli, vale a dire Jan, Feb e Mar. Di seguito sono riportate le istantanee di questi fogli:
Per combinare i dati di tutti i fogli in un unico foglio, dobbiamo seguire i passaggi seguenti per avviare l'editor VB:
- Fare clic sulla scheda Sviluppatore
- Dal gruppo Codice seleziona Visual Basic
- Copia il codice sottostante nel modulo standard
Sub CopyCurrentRegion() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long If SheetExists("Master") = True Then MsgBox "Il foglio Master esiste già" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh .Name = "Master" per ogni sh in ThisWorkbook.Worksheets If sh.Name DestSh.Name Then If sh.UsedRange.Count > 1 Then Last = LastRow(DestSh) sh.Range("A1").CurrentRegion.Copy DestSh. Cells (Last + 1, 1) End If End If Next Application.ScreenUpdating = True End Sub Sub CopyCurrentRegionValues() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long If SheetExists ("Master") = True Then MsgBox "Il foglio Il master esiste già" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name = "Master" Per ogni sh In ThisWorkbook.Worksheets If sh.Name DestSh.Name Then If sh.UsedRange.Count > 1 Then Last = LastRow(DestSh) With sh.Range("A1").CurrentRegion DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _ .Columns.Count).Value = .Value End With End If End If Next Application.ScreenUpdating = True End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range ("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function Lastcol(sh As Worksheet ) On Error Resume Next Lastcol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns , _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Function SheetExists(SName As String, _ Optional ByVal WB As Workbook) As Boolean On Error Riprendi successivo se WB non è nulla, quindi imposta WB = ThisWorkbook SheetExists = CBool(Len(Sheets(SName).Name)) End Function
La macro CopyCurrentRegion chiamerà la funzione "SheetExists" e controllerà se esiste un nome del foglio di lavoro con "Master"; se trovato, non farà nulla, altrimenti inserirà un nuovo foglio di lavoro nella cartella di lavoro attiva e lo rinominerà in "Master" e quindi copierà i dati da tutti i fogli.
Di seguito le istantanee dei dati consolidati:
Nota: la cartella di lavoro di esempio contiene il foglio di lavoro principale; si consiglia di eliminare il foglio di lavoro principale e quindi eseguire la macro per vedere il codice VBA funzionante.
Conclusione:Ora abbiamo il codice che possiamo usare per trasferire i dati da ogni foglio di lavoro in un foglio.
Se ti è piaciuto il nostro blog, condividilo con i tuoi amici su Facebook. E puoi anche seguirci su Twitter e Facebook.
Ci piacerebbe avere tue notizie, facci sapere come possiamo migliorare, completare o innovare il nostro lavoro e renderlo migliore per te. Scrivici al sito di posta elettronica