I den här artikeln kommer vi att skapa ett makro för en förening av flera områden till ett visst blad.
Raw data består av några provdata, som inkluderar namn och ålder. Vi har två områden som innehåller rådata. Vi vill ha en förening av båda områdena till "Destination" -arket.
Om du klickar på knappen "Kopiera post" förenas data från båda områdena tillsammans med formatering.
Om du klickar på knappen "Endast värdet kopiera" förenas också data från båda områdena, men utan att kopiera cellens format.
Kodförklaring
För varje Smallrng In Sheets ("Main"). Range ("A9: B13, D16: E20"). Områden
Nästa Smallrng
Ovanstående för varje slinga används för att slinga på definierade områden.
Set DestRange = Sheets ("Destination"). Range ("A" & LastRow)
Ovanstående kod används för att skapa ett intervallobjekt för den sista cellen, där vi vill kopiera data.
Smallrng.Copy DestRange
Ovanstående kod används för att kopiera data till den angivna destinationen.
Följ koden nedan
Alternativ Explicit Sub CopyMultiArea () 'Deklarationsvariabler Dim DestRange As Range Dim Smallrng As Range Dim LastRow As Long' Bläddra igenom angivna områden för varje Smallrng In Sheets ("Main"). Range ("A9: B13, D16: E20"). Områden 'Hitta radnumret för den sista cellen LastRow = Sheets ("Destination"). Område ("A1"). SpecialCells (xlLastCell) .Rad + 1' Välj den cell där poster måste kopieras Om LastRow = 2 Ställ sedan in Destrange = Sheets ("Destination"). Range ("A" & LastRow - 1) Else Set DestRange = Sheets ("Destination"). Range ("A" & LastRow) End If 'Kopierar poster till specificerat destinationsintervall Smallrng.Copy Destrange Nästa Smallrng End Sub Sub CopyMultiAreaValues () 'Deklarationsvariabler Dim DestRange As Range Dim Smallrng As Range Dim LastRow As Long' Looping through specific areas For Every Smallrng In Sheets ("Main"). Range ("A9: B13, D16: E20" ) .Areas 'Hitta radnumret för den sista cellen LastRow = Sheets ("Destination"). Range ("A1"). SpecialCells (xlLastCell) .Rad + 1 med Smallrng' Väljer cellen där sladdar måste kopieras Om LastRow = 2 Ställ sedan in 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
Om du gillade den här bloggen, dela den med dina vänner på Facebook. Du kan också följa oss på Twitter och Facebook.
Vi vill gärna höra från dig, låt oss veta hur vi kan förbättra vårt arbete och göra det bättre för dig. Skriv till oss på e -postwebbplatsen