Kopirajte CurrentRegion celice vsakega lista na en list z uporabo VBA v programu Microsoft Excel

Anonim

Če hkrati delate z več listi in želite kopirati podatke z vsakega lista na glavni delovni list, preberite ta članek. Lastnost currentregion kode VBA bomo uporabili za združevanje podatkov iz vseh delovnih listov v en list. Ta lastnost je uporabna za številne operacije, ki samodejno razširijo izbor na celotno trenutno območje, na primer metodo AutoFormat. Te lastnosti ni mogoče uporabiti na zaščitenem delovnem listu.

Pogoj je: vsak list mora vsebovati podobno obliko, tj. Enako število stolpcev; z isto obliko lahko natančno združimo podatke.

Upoštevajte: ta članek bo prikazal uporabo kode VBA; če se iz katerega koli razloga število stolpcev razlikuje na enem od listov, potem celotni združeni podatki ne bodo dali natančne slike. Zelo priporočljivo je, da uporabite enako število stolpcev. Koda VBA bo v delovni zvezek dodala nov list, nato pa kopirala in prilepila podatke po vsakem listu brez prepisovanja.

Vzemimo primer treh listov, in sicer januarja, februarja in marca. Sledi posnetek teh listov:

Če želimo združiti podatke z vseh listov v en list, moramo za zagon urejevalnika VB slediti spodnjim korakom:

  • Kliknite zavihek Razvijalec
  • V skupini Koda izberite Visual Basic

  • Kopirajte spodnjo kodo v standardni modul
Sub CopyCurrentRegion () Dim sh kot delovni list Dim DestSh kot delovni list Dim Last As Long If SheetExists ("Master") = True then MsgBox "Master Master List že obstaja" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh .Name = "Master" Za vsak sh v tej delovni knjigi. Delovni listi Če ime sh.DestSh.Name Potem, če sh.UsedRange.Count> 1 Potem Last = LastRow (DestSh) sh.Range ("A1"). CurrentRegion.Copy DestSh. Celice (Zadnji + 1, 1) Končaj, če se konča, če je naslednja aplikacija.ScreenUpdating = True End Sub Sub CopyCurrentRegionValues ​​() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long If SheetExists ("Master") = True then MsgBox "List Glavni že obstaja "Izhod iz podkoncepta, če je Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name =" Master "Za vsako sh v tej delovni knjigi. Delovni listi If sh.Name DestSh.Name Then If sh.UsedRange.Count> 1 Potem Last = LastRow (DestSh) With sh.Range ("A1"). CurrentRegion DestSh.Cells (Last + 1, 1) .Resize (.Rows.Count, _ .Columns.Count) .Vrednost = .Vrednost Konec s koncem Če konec Če naslednja aplikacija.ScreenUpdating = True End Podfunkcija LastRow (sh kot delovni list) On Napaka Nadaljuj Next LastRow = sh.Cells.Find (Kaj: = "*", _ After: = sh.Range ("A1"), _ Iskanje: = xlPart, _ LookIn: = xlFormulas, _ SearchOrder: = xlByRows, _ SearchDirection: = xlPrevious, _ MatchCase: = False). Napaka pri vklopu GoTo 0 Končaj funkcijo Lastcol ) On Error Resume Next Lastcol = sh.Cells.Find (Kaj: = "*", _ After: = sh.Range ("A1"), _ Lookat: = xlPart, _ LookIn: = xlFormulas, _ SearchOrder: = xlByColumns , _ SearchDirection: = xlPrevious, _ MatchCase: = False). Stolpec Napaka GoTo 0 End Function SheetExists (SName As String, _ Optional ByVal WB As Workbook) Kot Boolean On Napaka Nadaljuj Naprej Če WB ni nič, potem nastavite WB = Ta delovni zvezek SheetExists = CBool ​​(Len (Sheets (SName) .Name)) Končna funkcija 

Makro CopyCurrentRegion bo poklical funkcijo "SheetExists" in preveril, ali obstaja ime delovnega lista z "Master"; če ga najde, ne bo naredil nič, sicer bo v delovni zvezek vstavil nov delovni list in ga preimenoval v »Master«, nato pa bo kopiral podatke z vseh listov.

Sledijo utrinki konsolidiranih podatkov:

Opomba: Vzorec delovnega zvezka vsebuje glavni delovni list; Predlagamo, da izbrišete glavni delovni list in nato zaženete makro, da vidite, kako deluje koda VBA.

Zaključek:Zdaj imamo kodo, s katero lahko podatke iz vsakega delovnega lista prenesemo v en list.

Če so vam bili naši blogi všeč, jih delite s prijatelji na Facebooku. Prav tako nas lahko spremljate na Twitterju in Facebooku.

Radi bi slišali od vas, nam sporočite, kako lahko izboljšamo, dopolnimo ali inoviramo svoje delo in ga izboljšamo. Pišite nam na spletni strani elektronske pošte