Kopējiet katras lapas UsedRange vienā lapā, izmantojot Microsoft Excel VBA

Anonim

Ja vēlaties kopēt katras darblapas izmantoto diapazonu galvenajā lapā, jums jāizlasa šis raksts. Mēs izmantosim VBA kodu, lai kopētu datus no katras darblapas un pēc tam ielīmētu citā lapā bez pārrakstīšanas.

Makro pievienos jūsu darbgrāmatai lapu ar nosaukumu Meistars un kopēs šūnas no katras šīs darblapas darbgrāmatas lapas.

Pirmais makro veic parastu kopiju, bet otrs makro kopē vērtības. Makro apakšsadaļas izmanto tālāk norādītās funkcijas; makro nedarbosies bez funkcijām.

Tālāk ir sniegts datu momentuzņēmums no lapām1 un lapas2:

Lai palaistu VB redaktoru, mums jāveic šādas darbības:

  • Noklikšķiniet uz cilnes Izstrādātājs
  • Kodu grupā atlasiet Visual Basic

  • Nokopējiet zemāk esošo kodu standarta modulī
Sub CopyUsedRange () Dim sh kā darblapa Dim DestSh kā darblapa Dim pēdējā tik ilgi, ja SheetExists ("Master") = True Tad MsgBox "Lapu šablons jau pastāv" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh .Name = "Master" Par katru sh šajā darbagrāmatā.Darblapas Ja sh.Name DestSh.Name Tad Ja sh.UsedRange.Count> 1 Tad Last = LastRow (DestSh) sh.UsedRange.Copy DestSh.Cells (Pēdējais + 1, 1 ) Beigas Ja beigas Ja nākamā lietojumprogramma.ScreenUpdating = Patiess beigas Apakškopija CopyUsedRangeValues ​​() Dim sh kā darblapa Dim DestSh kā darblapa Dim pēdējā tik ilgi, ja SheetExists ("Master") = True Tad MsgBox "Lapu šablons jau pastāv" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name = "Master" Par katru sh šajā ThisWorkbook.Worksheets Ja sh.Name DestSh.Name Tad Ja sh.UsedRange.Count> 1 Tad Last = LastRow (DestSh) ar sh.UsedRange DestSh.Cells (pēdējais + 1, 1). Izmērs (.Rows.Count, _ .Columns.Count) .Value = .Value End End with End If End If Next Ap plication.ScreenUpdating = Patiesa beigu apakšfunkcija LastRow (sh kā darblapa) Par kļūdu Atsākt nākamo rindu = sh.Cells.Find (What: = "*", _ After: = sh.Range ("A1"), _ Lookat: = xlPart, _ LookIn: = xlFormulas, _ SearchOrder: = xlByRows, _ SearchDirection: = xlPrevious, _ MatchCase: = False). .Find (What: = "*", _ After: = sh.Range ("A1"), _ Lookat: = xlPart, _ LookIn: = xlFormulas, _ SearchOrder: = xlByColumns, _ SearchDirection: = xlPrevious, _ MatchCase: = False). Sleja On Error GoTo 0 End Function Function SheetExists (SName kā virkne, _ Neobligāts ByVal WB kā darbgrāmata) Kā Būla kļūda Atsākt nākamo, ja WB nav nekas, tad iestatīt WB = ThisWorkbook SheetExists = CBool ​​(Len (Sheets (SName) .Nosaukums)) Beigu funkcija 

Tagad makro kods ir iestatīts; mēs palaidīsim makro “CopyUsedRange”, un tas ievietos jaunu lapu “Master” un nokopēs datus no katras lapas.

Secinājums:Datu kopēšana no vairākām lapām ir manuāls uzdevums; tomēr; izmantojot iepriekš minēto kodu, mēs varam konsolidēt datus ar vienu klikšķi uz makro.

Ja jums patika mūsu emuāri, kopīgojiet to ar saviem draugiem Facebook. Un arī jūs varat sekot mums Twitter un Facebook.

Mēs labprāt uzklausītu jūsu viedokli, dariet mums zināmu, kā mēs varam uzlabot, papildināt vai ieviest jauninājumus mūsu darbā un uzlabot to jūsu labā. Rakstiet mums e -pasta vietnē