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

Anonim

В случай, че искате да копирате използвания диапазон от всеки работен лист в основния лист, тогава трябва да прочетете тази статия. Ще използваме VBA код, за да копираме данните от всеки работен лист и след това да поставим в друг лист, без да го презаписваме.

Макросът ще добави лист с името Master към вашата работна книга и ще копира клетките от всеки лист във вашата работна книга в този работен лист.

Първият макрос прави нормално копиране, а вторият макрос копира стойностите. Подводниците на макроса използват функциите по -долу; макросът няма да работи без функциите.

Следва моментна снимка на данни от Sheet1 & Sheet2:

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

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

  • Копирайте кода по -долу в стандартния модул
Sub CopyUsedRange () 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.UsedRange.Copy DestSh.Cells (Last + 1, 1 ) End If End If Next Application.ScreenUpdating = True End Sub Sub CopyUsedRangeValues ​​() 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 Тогава If sh.UsedRange.Count> 1 Тогава Last = LastRow (DestSh) С sh.UsedRange DestSh.Cells (Last + 1, 1) .Resize (.Rows.Count, _ .Columns.Count) .Value = .Value End With End If End If Next Ap plication.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). Грешка при влизане GoTo 0 Крайна функция Функция Lastcol (sh As Worksheet) On Error Resume Next Lastcol = sh.Cells .Find (What: = "*", _ After: = sh.Range ("A1"), _ Lookat: = xlPart, _ LookIn: = xlFormulas, _ SearchOrder: = xlByColumns, _ SearchDirection: = xlPrevious, _ MatchCase: Колона при грешка GoTo 0 Крайна функция Функция SheetExt (SName As String, _ Незадължително ByVal WB като работна книга) Като Boolean On Error Resume Next Ако WB не е нищо След това задайте WB = ThisWorkbook SheetExists = CBool ​​(Len (Sheets (SName) . Име)) Крайна функция

Сега макрокодът е зададен; ще стартираме макроса „CopyUsedRange“ и той ще вмъкне нов лист „Master“ и ще копира данните от всеки лист.

Заключение:Копирането на данни от няколко листа е ръчна задача; въпреки това; с горния код можем да обединим данните с едно щракване върху макрос.

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

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