Copiar un rango con más áreas para una hoja especificada utilizando VBA en Microsoft Excel
En este artículo, crearemos una macro para la unión de varias áreas en una hoja específica.
Los datos brutos consisten en algunos datos de muestra, que incluyen el nombre y la edad. Tenemos dos áreas que contienen datos sin procesar. Queremos una unión de ambas áreas a la hoja “Destino”.
Al hacer clic en el botón «Copiar registro» se hará la unión de los datos de ambas áreas, junto con el formato.
Al hacer clic en el botón “Copiar solo valor” también se realizará la unión de datos de ambas áreas, pero sin copiar el formato de la celda.
Explicación del código
For Each Smallrng In Sheets («Main»). Range («A9: B13, D16: E20»). Areas Next Smallrng El Para Cada bucle anterior se utiliza para realizar un bucle en áreas definidas.
Establecer DestRange = Sheets («Destino»). Rango («A» & LastRow)
El código anterior se usa para crear un objeto de rango de la última celda, donde queremos copiar los datos.
Smallrng.Copy DestRange El código anterior se utiliza para copiar datos al destino especificado.
Siga a continuación el código
Option Explicit
Sub CopyMultiArea()
'Declaring variables
Dim DestRange As Range
Dim Smallrng As Range
Dim LastRow As Long
'Looping through specified areas
For Each Smallrng In Sheets("Main").Range("A9:B13,D16:E20").Areas
'Finding the row number of last cell
LastRow = Sheets("Destination").Range("A1").SpecialCells(xlLastCell).Row + 1
'Selecting the cell where records need to be copy
If LastRow = 2 Then
Set DestRange = Sheets("Destination").Range("A" & LastRow - 1)
Else
Set DestRange = Sheets("Destination").Range("A" & LastRow)
End If
'Copying records to specified destination range
Smallrng.Copy DestRange
Next Smallrng
End Sub
Sub CopyMultiAreaValues()
'Declaring variables
Dim DestRange As Range
Dim Smallrng As Range
Dim LastRow As Long
'Looping through specified areas
For Each Smallrng In Sheets("Main").Range("A9:B13,D16:E20").Areas
'Finding the row number of last cell
LastRow = Sheets("Destination").Range("A1").SpecialCells(xlLastCell).Row + 1
With Smallrng
'Selecting the cell where records need to be copy
If LastRow = 2 Then
Set DestRange = Sheets("Destination").Range("A" & LastRow - 1).Resize(.Rows.Count, .Columns.Count)
Else
Set DestRange = Sheets("Destination").Range("A" & LastRow).Resize(.Rows.Count, .Columns.Count)
End If
End With
'Assigning the values from source to destination
DestRange.Value = Smallrng.Value
Next Smallrng
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]