In dit artikel zullen we een macro maken voor een samenvoeging van meerdere gebieden op een bepaald blad.
Ruwe gegevens bestaan uit enkele voorbeeldgegevens, waaronder naam en leeftijd. We hebben twee gebieden die ruwe gegevens bevatten. We willen een unie van beide gebieden op het blad 'Bestemming'.
Als u op de knop "Record kopiëren" klikt, worden gegevens uit beide gebieden samengevoegd, samen met opmaak.
Als u op de knop "Alleen waarde kopiëren" klikt, worden ook gegevens uit beide gebieden samengevoegd, maar zonder het formaat van de cel te kopiëren.
Code uitleg
Voor elke Smallrng In Sheets ("Hoofd"). Bereik ("A9:B13,D16:E20").Gebieden
Volgende Smallrng
De bovenstaande For Each-lus wordt gebruikt om op gedefinieerde gebieden te lussen.
Stel DestRange = Sheets ("Destination") in. Range ("A" & LastRow)
De bovenstaande code wordt gebruikt om een bereikobject van de laatste cel te maken, waar we de gegevens willen kopiëren.
Smallrng.Copy DestRange
De bovenstaande code wordt gebruikt om gegevens naar de opgegeven bestemming te kopiëren.
Volg hieronder voor de code:
Optie Explicit Sub CopyMultiArea() 'Variabelen declareren Dim DestRange As Range Dim Smallrng As Range Dim LastRow As Long 'Door gespecificeerde gebieden doorlopen voor elke Smallrng In Sheets("Main").Range("A9:B13,D16:E20"). Gebieden 'Het rijnummer van de laatste cel zoeken LastRow = Sheets("Destination").Range("A1").SpecialCells(xlLastCell).Row + 1 'De cel selecteren waar records moeten worden gekopieerd If LastRow = 2 Then Set DestRange = Sheets("Destination").Range("A" & LastRow - 1) Else Set DestRange = Sheets("Destination").Range("A" & LastRow) End If 'Records kopiëren naar gespecificeerd bestemmingsbereik Smallrng.Copy DestRange Volgende Smallrng End Sub Sub CopyMultiAreaValues() 'Variabelen declareren Dim DestRange As Range Dim Smallrng As Range Dim LastRow As Long 'Door gespecificeerde gebieden doorlopen For Each Smallrng In Sheets("Main").Range("A9:B13,D16:E20" ).Areas 'Het rijnummer van de laatste cel zoeken LastRow = Sheets("Destination").Range("A1").SpecialCells(xlLastCell).Row + 1 With Smallrng 'Selecteer de cel waar koorden moeten worden gekopieerd Als LastRow = 2 Stel dan DestRange = Sheets ("Destination") in.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 'Toewijzen van de waarden van bron naar bestemming DestRange.Value = Smallrng.Value Next Smallrng End Sub
Als je deze blog leuk vond, deel hem dan met je vrienden op Facebook. Ook kunt u ons volgen op Twitter en Facebook.
We horen graag van u, laat ons weten hoe we ons werk kunnen verbeteren en voor u kunnen verbeteren. Schrijf ons op de e-mailsite