Copie CurrentRegion de una celda de cada hoja en una hoja usando VBA en Microsoft Excel

Anonim

Si maneja 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, entonces todos los datos combinados no darán una imagen precisa. Se recomienda encarecidamente 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 de 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 "La hoja maestra ya existe" Salir Sub End If Application.ScreenUpdating = False Establecer DestSh = Worksheets.Add DestSh .Name = "Master" para cada sh En ThisWorkbook.Worksheets If sh.Name DestSh.Name Then If sh.UsedRange.Count> 1 Then Last = LastRow (DestSh) sh.Range ("A1"). CurrentRegion.Copy DestSh. Celdas (Última + 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 "La hoja Master ya existe "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) Con 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 función 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 Función Lastcol (sh Como hoja de trabajo ) En caso de error Reanudar Siguiente 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) Como booleano en caso de error Continuar siguiente Si WB no es nada Entonces establezca WB = ThisWorkbook SheetExists = CBool ​​(Len (Sheets (SName) .Name)) End Function

La macro CopyCurrentRegion llamará a la función "SheetExists" y comprobará si hay un nombre de hoja de trabajo que tenga "Master"; si se encuentra, no hará nada, de lo contrario, insertará una nueva hoja de trabajo en el libro de trabajo activo y le cambiará el nombre a "Maestro" y luego copiará los datos de todas las hojas.

A continuación se muestran las instantáneas de los datos consolidados:

Nota: El libro de trabajo de muestra contiene una hoja de trabajo maestra; se sugiere eliminar la hoja de trabajo maestra y luego ejecutar la macro para ver el código VBA funcionando.

Conclusión:Ahora tenemos el código que podemos usar para transferir datos de cada hoja de trabajo a una hoja.

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 al sitio de correo electrónico