Copiar un rango de cada hoja en una hoja utilizando Microsoft Excel VBA en
En este artículo, crearemos una macro para copiar datos de todas las hojas del libro de trabajo a una nueva hoja.
Los datos brutos para este ejemplo consisten en detalles de empleados de diferentes departamentos en diferentes hojas. Queremos consolidar los detalles de los empleados en una sola hoja.
Hemos creado la macro “CopyRangeFromMultipleSheets” para la consolidación de los datos. Esta macro se puede ejecutar haciendo clic en el botón «Consolidar datos».
Macro creará una nueva hoja de trabajo e insertará los datos consolidados de todas las hojas de trabajo.
Explicación del código
‘Recorriendo todas las hojas para comprobar si existe la hoja «Maestra».
Para cada fuente en ThisWorkbook.Worksheets If Source.Name = «Master» Then MsgBox «La hoja maestra ya existe»
Exit Sub End Si se usa el código Next Above para verificar si existe la hoja “Master” en el libro de trabajo. Si existe una hoja «Maestra» en el libro de trabajo, el código sale y se muestra un mensaje de error.
Source.Range («A1»). SpecialCells (xlLastCell). El código de la fila anterior se usa para obtener el número de fila de la última celda de la hoja.
Source.Range («A1», Range («A1»). SpecialCells (xlLastCell)). Copiar Destination.Range («A» & DestLastRow)
El código anterior se usa para copiar el rango especificado a la celda definida.
Siga el código a continuación
Sub CopyRangeFromMultipleSheets()
'Declaring variables
Dim Source As Worksheet
Dim Destination As Worksheet
Dim SourceLastRow, DestLastRow As Long
Application.ScreenUpdating = False
'Looping through all sheets to check whether "Master" sheet exist
For Each Source In ThisWorkbook.Worksheets
If Source.Name = "Master" Then
MsgBox "Master sheet already exist"
Exit Sub
End If
Next
'Inserting a new sheet after the "Main" sheet
Set Destination = Worksheets.Add(after:=Sheets("Main"))
Destination.Name = "Master"
'Looping through all the sheets in the workbook
For Each Source In ThisWorkbook.Worksheets
'Preventing consolidation of data from "Main" and "Master" sheet
If Source.Name <> "Main" And Source.Name <> "Master" Then
SourceLastRow = Source.Range("A1").SpecialCells(xlLastCell).Row
Source.Activate
If Source.UsedRange.Count > 1 Then
DestLastRow = Sheets("Master").Range("A1").SpecialCells(xlLastCell).Row
If DestLastRow = 1 Then
'copying data from the source sheet to destination sheet
Source.Range("A1", Range("A1").SpecialCells(xlLastCell)).Copy Destination.Range("A" & DestLastRow)
Else
Source.Range("A2", Range("A1").SpecialCells(xlCellTypeLastCell)).Copy Destination.Range("A" & (DestLastRow + 1))
End If
End If
End If
Next
Destination.Activate
Application.ScreenUpdating = True
End Sub
Si te gustó este blog, compártelo con tus amigos en Facebook y Facebook.
Nos encantaría saber de usted, háganos saber cómo podemos mejorar nuestro trabajo y hacerlo mejor para usted. Escríbanos a [email protected]