Copier une gamme avec plus de zones à une feuille spécifiée en utilisant VBA dans Microsoft Excel
Dans cet article, nous allons créer une macro pour une union de plusieurs zones à une feuille spécifiée.
Les données brutes se composent de quelques exemples de données, qui incluent le nom et l’âge. Nous avons deux zones qui contiennent des données brutes. Nous voulons une union des deux zones à la feuille «Destination».
Cliquer sur le bouton « Copier l’enregistrement » fera l’union des données des deux zones, ainsi que le formatage.
Cliquer sur le bouton « Copier la valeur uniquement » fera également l’union des données des deux zones, mais sans copier le format de la cellule.
Explication du code
For Each Smallrng In Sheets (« Main »). Range (« A9: B13, D16: E20 »). Areas Next Smallrng La boucle For Each ci-dessus est utilisée pour boucler sur des zones définies.
Définissez DestRange = Sheets (« Destination »). Range (« A » & LastRow)
Le code ci-dessus est utilisé pour créer un objet de plage de la dernière cellule, où nous voulons copier les données.
Smallrng.Copy DestRange Le code ci-dessus est utilisé pour copier des données vers la destination spécifiée.
Veuillez suivre ci-dessous pour le code
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 vous avez aimé ce blog, partagez-le avec vos amis sur Facebook et Facebook.
Nous serions ravis de vous entendre, faites-nous savoir comment nous pouvons améliorer notre travail et le rendre meilleur pour vous. Écrivez-nous à [email protected]