Copiar el CurrentRegion de una célula de cada hoja en una hoja utilizando Microsoft Excel VBA en
Si está manejando varias hojas a la vez y desea copiar los datos de cada hoja en una hoja de trabajo maestra, debe leer este artículo. Usaremos la propiedad currentregion del código VBA para consolidar los datos de todas las hojas de trabajo en una sola hoja. Esta propiedad es útil para muchas operaciones que expanden automáticamente la selección para incluir toda la región actual, como el método Autoformato. Esta propiedad no se puede utilizar en una hoja de trabajo protegida.
La condición es: cada hoja debe contener un formato similar, es decir, el mismo número de columnas; utilizando el mismo formato podemos tener datos fusionados con precisión.
Tenga en cuenta: este artículo demostrará el uso del código VBA; Si por alguna razón el número de columnas difiere en una de las hojas, los datos combinados completos no darán una imagen precisa. Se recomienda utilizar el mismo número de columnas. El código VBA agregará una nueva hoja al libro de trabajo y luego copiará y pegará los datos después de cada hoja sin sobrescribir.
Tomemos un ejemplo de 3 hojas, a saber, enero, febrero y marzo. A continuación se muestra la instantánea de estas hojas:
Para combinar datos de todas las hojas en una hoja, debemos seguir los pasos a continuación para iniciar el editor de VB:
Haga clic en la pestaña Desarrollador. Desde el grupo Código, seleccione Visual Basic
-
Copie el siguiente código en el módulo estándar
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
Si te gustaron nuestros blogs, compártelo con tus amigos en Facebook. Y también puedes seguirnos en Twitter y Facebook.
Nos encantaría saber de usted, háganos saber cómo podemos mejorar, complementar o innovar nuestro trabajo y hacerlo mejor para usted. Escríbanos a [email protected]