Hvis du håndterer flere ark ad gangen, og du vil kopiere data fra hvert ark til et hovedark, skal du læse denne artikel. Vi vil bruge currentregion -ejendommen til VBA -kode til at konsolidere data fra alle regnearkene til et enkelt ark. Denne egenskab er nyttig til mange operationer, der automatisk udvider markeringen til at omfatte hele den aktuelle region, f.eks. AutoFormat -metoden. Denne egenskab kan ikke bruges på et beskyttet regneark.
Betingelsen er: hvert ark skal indeholde lignende format, dvs. samme antal kolonner; ved hjælp af samme format kan vi have nøjagtigt flettede data.
Bemærk venligst: denne artikel demonstrerer brug af VBA -kode; hvis antallet af kolonner af en eller anden grund er forskelligt i et af arkene, så vil de flettede data ikke give et nøjagtigt billede. Det anbefales stærkt at bruge samme antal kolonner. VBA -koden tilføjer et nyt ark til projektmappen og kopierer og indsætter derefter dataene efter hvert ark uden at overskrive.
Lad os tage et eksempel på 3 ark, nemlig Jan, Feb & Mar. Følgende er øjebliksbillede af disse ark:
For at kombinere data fra alle arkene til et ark skal vi følge nedenstående trin for at starte VB -editor:
- Klik på fanen Udvikler
- Vælg Visual Basic fra kodegruppen
- Kopier nedenstående kode i standardmodulet
Sub CopyCurrentRegion () Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long If SheetExists ("Master") = True Then MsgBox "Sheet Master exist exist" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh .Name = "Master" for hver sh i ThisWorkbook.Worksheets If sh.Name DestSh.Name Then If sh.UsedRange.Count> 1 Then Last = LastRow (DestSh) sh.Range ("A1"). CurrentRegion.Copy DestSh. Celler (Sidste + 1, 1) Slut hvis ende Hvis næste applikation.ScreenUpdating = True End Sub Sub CopyCurrentRegionValues () Dim sh som regneark Dim DestSh Som regneark Dim Last As Long If SheetExists ("Master") = True Then MsgBox "Arket Master eksisterer allerede "Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name =" Master "For hver sh i ThisWorkbook.Worksheets If sh.Name DestSh.Name Then If sh.UsedRange.Count> 1 Then Last = LastRow (DestSh) With sh.Range ("A1"). CurrentRegion DestSh.Cells (Last + 1, 1) .Resize (.Rows.Count, _ .Columns.Count) .Value = .Value End With End If End If Next Application.ScreenUpdating = True End Sub Function LastRow (sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find (What: = "*", _ After: = sh.Range ("A1"), _ Lookat: = xlPart, _ LookIn: = xlFormulas, _ SearchOrder: = xlByRows, _ SearchDirection: = xlPrevious, _ MatchCase: = False) .Række på fejl Gå til 0 Afslut funktion Funktion Lastcol (sh Som regneark ) Ved fejl Genoptag Næste Lastcol = sh.Cells.Find (Hvad: = "*", _ Efter: = sh.Range ("A1"), _ Lookat: = xlPart, _ LookIn: = xlFormulas, _ SearchOrder: = xlByColumns , _ SearchDirection: = xlPrevious, _ MatchCase: = False) .Column On Error GoTo 0 Slut funktion Funktion SheetExists (SName As String, _ Valgfri ByVal WB som arbejdsbog) Som boolsk ved fejl Genoptag næste hvis WB ikke er noget, så indstil WB = ThisWorkbook SheetExists = CBool (Len (Sheets (SName) .Name)) Slutfunktion
CopyCurrentRegion -makroen kalder funktionen "SheetExists" og kontrollerer, om der er et regnearksnavn med "Master"; hvis den findes, vil den ikke gøre noget, ellers vil den indsætte nyt regneark i den aktive arbejdsbog og omdøbe den til "Master", og derefter vil den kopiere data fra alle arkene.
Følgende er øjebliksbilleder af konsoliderede data:
Bemærk: Eksempelprojektmappen indeholder Master -regneark; det foreslås at slette Master -regnearket og derefter køre makroen for at se VBA -koden fungerer.
Konklusion:Nu har vi den kode, vi kan bruge til at overføre data fra hvert regneark til et ark.
Hvis du kunne lide vores blogs, kan du dele den med dine venner på Facebook. Og også du kan følge os på Twitter og Facebook.
Vi vil meget gerne høre fra dig, lad os vide, hvordan vi kan forbedre, supplere eller innovere vores arbejde og gøre det bedre for dig. Skriv til os på e -mail -stedet