Копирайте CurrentRegion на клетка от всеки лист в един лист с помощта на VBA в Microsoft Excel

Anonim

Ако работите с няколко листа едновременно и искате да копирате данни от всеки лист в основен работен лист, трябва да прочетете тази статия. Ще използваме свойство currentregion на VBA код за консолидиране на данни от всички работни листове в един лист. Това свойство е полезно за много операции, които автоматично разширяват селекцията, за да включат целия текущ регион, като например метода AutoFormat. Това свойство не може да се използва на защитен работен лист.

Условието е: всеки лист трябва да съдържа подобен формат, т.е. същия брой колони; използвайки същия формат можем да имаме точно обединени данни.

Моля, обърнете внимание: тази статия ще демонстрира използване на VBA код; ако по някаква причина броят на колоните се различава в един от листовете, тогава всички обединени данни няма да дадат точна картина. Силно се препоръчва използването на същия брой колони. Кодът VBA ще добави нов лист към работната книга и след това ще копира и постави данните след всеки лист, без да го презаписва.

Нека вземем пример за 3 листа, а именно януари, февруари и март. Следват моментните снимки на тези листове:

За да комбинираме данни от всички листове в един лист, трябва да следваме стъпките по -долу, за да стартираме VB редактор:

  • Кликнете върху раздела Разработчик
  • От групата кодове изберете Visual Basic

  • Копирайте кода по -долу в стандартния модул
Sub CopyCurrentRegion () Dim sh като работен лист Dim DestSh като работен лист Dim Последно толкова дълго, ако SheetExists ("Master") = True Тогава MsgBox "Master Master вече съществува" Излезте от Sub End, ако Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh .Name = "Master" За всеки sh в ThisWorkbook.Worksheets Ако sh.Name DestSh.Name Тогава Ако sh.UsedRange.Count> 1 Тогава Last = LastRow (DestSh) sh.Range ("A1"). CurrentRegion.Copy DestSh. Клетки (Last + 1, 1) End If End If Next Application. Главен вече съществува "Изход за подкрай, ако Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name =" Master "За всеки sh в ThisWorkbook.Worksheets Ако sh.Name DestSh.Name Тогава Ако sh.UsedRange.Count> 1 Тогава Last = LastRow (DestSh) С 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"), _ Търсене: = xlPart, _ LookIn: = xlFormulas, _ SearchOrder: = xlByRows, _ SearchDirection: = xlPrevious, _ MatchCase: = False). ) On Error Resume Next Lastcol = sh.Cells.Find (What: = "*", _ After: = sh.Range ("A1"), _ Lookat: = xlPart, _ LookIn: = xlFormulas, _ SearchOrder: = xlByColumns , _ SearchDirection: = xlPrevious, _ MatchCase: = False). Колона при грешка GoTo 0 Крайна функция Функционален лист Съществува (SName As String, _ Незадължително ByVal WB като работна книга) Като булева стойност при възобновяване на грешката Следваща Ако WB не е нищо След това задайте WB = ThisWorkbook SheetExists = CBool ​​(Len (Sheets (SName) .Name)) Крайна функция

Макросът CopyCurrentRegion ще извика функцията „SheetExists“ и ще провери дали има име на работен лист с „Master“; ако бъде намерен, той няма да направи нищо, иначе ще вмъкне нов работен лист в активната работна книга и ще го преименува на „Master“ и след това ще копира данни от всички листове.

Следват моментните снимки на консолидираните данни:

Забележка: Примерната работна книга съдържа главен работен лист; се препоръчва да изтриете главния работен лист и след това да стартирате макроса, за да видите кода VBA.

Заключение:Сега имаме кода, който можем да използваме за прехвърляне на данни от всеки работен лист в един лист.

Ако ви харесаха нашите блогове, споделете го с приятелите си във Facebook. Можете също така да ни следвате в Twitter и Facebook.

Ще се радваме да чуем от вас, уведомете ни как можем да подобрим, допълним или обновим работата си и да я подобрим. Пишете ни на имейл сайта