Tässä artikkelissa luomme makron, joka kopioi tiedot kaikista työkirjan arkeista uudelle arkille.
Tämän esimerkin raakatiedot koostuvat eri osastojen työntekijöiden tiedoista eri arkeilla. Haluamme yhdistää työntekijöiden tiedot yhdeksi arkiksi.
Olemme luoneet "CopyRangeFromMultipleSheets" -makron tietojen yhdistämiseksi. Tämä makro voidaan suorittaa napsauttamalla ”Yhdistä tiedot” -painiketta.
Makro luo uuden laskentataulukon ja lisää yhdistetyt tiedot kaikista laskentataulukoista.
Koodin selitys
"Silmukkaa" kaikki taulukot ja tarkista, onko "pää" -arkki olemassa.
Jokaiselle tämän työkirjan lähteelle
Jos Source.Name = "Master" Sitten
MsgBox "Pääarkki on jo olemassa"
Lopeta Sub
Loppu Jos
Seuraava
Yllä olevaa koodia käytetään tarkistamaan, onko työkirjassa "pää" -arkki. Jos työkirjassa on "Master" -arkki, koodi poistuu ja näyttöön tulee virhesanoma.
Source.Range ("A1"). SpecialCells (xlLastCell) .Row
Yllä olevaa koodia käytetään arkin viimeisen solun rivinumeron saamiseen.
Source.Range ("A1", alue ("A1"). SpecialCells (xlLastCell)). Kopioi Destination.Range ("A" & DestLastRow)
Yllä olevaa koodia käytetään kopioimaan määritetty alue määritettyyn soluun.
Seuraa koodia alla
Sub CopyRangeFromMultipleSheets () 'Ilmoittavat muuttujat Dim Lähde laskentataulukkona Dim Destination kuin laskentataulukko Dim SourceLastRow, DestLastRow As Long Application.ScreenUpdating = False' Silmukka läpi kaikki taulukot tarkistaakseen, onko "Master" -arkki olemassa jokaiselle lähteelle tässä työkirjassa.Worksheets If Source.Name = "Päällikkö" Sitten MsgBox "Pääarkki on jo olemassa" Poistu alipäästä Jos seuraava 'Uuden arkin lisääminen "Pää" -arkin jälkeen Aseta kohde = laskentataulukot.Add (after: = Sheets ("Main")) Destination.Name = " Päällikkö "'Silmukkaa työkirjan kaikki taulukot kullekin tämän työkirjan lähteelle. Työsivut' Tietojen yhdistämisen estäminen" Pää " - ja" Pää "-arkista, jos lähde.Nimi" Pää "ja Lähde.Nimi" Päällikkö "Sitten SourceLastRow = Lähde .Range ("A1"). SpecialCells (xlLastCell) .Row Source.Activate If Source.UsedRange.Count> 1 Sitten DestLastRow = Sheets ("Master"). Range ("A1"). SpecialCells (xlLastCell) .Row If DestLastRow = 1 Sitten 'kopioidaan tiedot lähdearkista kohdearkille Source.Range ("A 1 ", alue (" A1 "). SpecialCells (xlLastCell)). Kopioi Destination.Range (" A "& DestLastRow) Else Source.Range (" A2 ", Range (" A1 "). SpecialCells (xlCellTypeLastCell)). Kopioi Destination.Range ("A" & (DestLastRow + 1)) End Jos End Jos End Jos End Jos seuraava kohde. Aktivoi Application.ScreenUpdating = True End Sub
Jos pidit tästä blogista, jaa se ystävillesi Facebookissa. Voit myös seurata meitä Twitterissä ja Facebookissa.
Haluaisimme kuulla sinusta, kerro meille, kuinka voimme parantaa työtämme ja parantaa sitä sinulle. Kirjoita meille sähköpostitse