Copiare il CurrentRegion di una cellula di ogni foglio in un foglio utilizzando VBA in Microsoft Excel
Se gestisci più fogli contemporaneamente e desideri copiare i dati da ogni foglio in un foglio di lavoro principale, dovresti leggere questo articolo. Useremo la proprietà currentregion del codice VBA per consolidare i dati di tutti i fogli di lavoro in un unico foglio. Questa proprietà è utile per molte operazioni che espandono automaticamente la selezione per includere l’intera regione corrente, come il metodo AutoFormat. Questa proprietà non può essere utilizzata su 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, tutti i dati uniti non daranno un’immagine precisa. Si consiglia vivamente di utilizzare lo stesso numero di colonne. Il codice VBA aggiungerà un nuovo foglio alla cartella di lavoro e quindi copia e incolla i dati dopo ogni foglio senza sovrascriverli.
Prendiamo un esempio di 3 fogli, vale a dire gennaio, febbraio e marzo. Di seguito è riportata l’istantanea 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 selezionare Visual Basic
-
Copia il codice seguente nel modulo standard
Sub CopyCurrentRegion()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each 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 "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each 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 Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(Sheets(SName).Name))
End Function
Se i nostri blog ti sono piaciuti, condividilo con i tuoi amici su Facebook. E anche tu puoi seguirci su Twitter e Facebook.
_ Ci piacerebbe sentire la tua opinione, facci sapere come possiamo migliorare, integrare o innovare il nostro lavoro e renderlo migliore per te. Scrivici a [email protected]_