Скопируйте CurrentRegion ячейки каждого листа в одном листе с помощью VBA в Microsoft Excel
Если вы одновременно обрабатываете несколько листов и хотите скопировать данные с каждого листа в основной рабочий лист, вам следует прочитать эту статью. Мы будем использовать свойство currentregion кода VBA, чтобы объединить данные со всех листов в один лист. Это свойство полезно для многих операций, которые автоматически расширяют выделение для включения всей текущей области, например для метода AutoFormat. Это свойство нельзя использовать на защищенном листе .
Условие: каждый лист должен содержать одинаковый формат, то есть одинаковое количество столбцов; используя тот же формат, мы можем точно объединить данные.
Обратите внимание: в этой статье будет продемонстрировано использование кода VBA; если по какой-либо причине количество столбцов на одном из листов различается, то все объединенные данные не дадут точной картины. Настоятельно рекомендуется использовать одинаковое количество столбцов. Код VBA добавит новый лист в книгу, а затем скопирует и вставит данные после каждого листа без перезаписи.
Давайте возьмем для примера 3 листа, а именно январь, февраль и март. Ниже приведены снимки этих листов:
Чтобы объединить данные со всех листов в один, нам нужно выполнить следующие шаги, чтобы запустить редактор VB:
Щелкните вкладку «Разработчик». В группе «Код» выберите Visual Basic
-
Скопируйте приведенный ниже код в стандартный модуль
Sub CopyCurrentRegion()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
sh.Range("A1").CurrentRegion.Copy DestSh.Cells(Last + 1, 1)
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Sub CopyCurrentRegionValues()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In 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).Row
On Error GoTo 0
End Function
Function 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:=False).Column
On Error GoTo 0
End Function
Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(Sheets(SName).Name))
End Function
Если вам понравились наши блоги, поделитесь ими с друзьями на Facebook. А также вы можете подписаться на нас в Twitter и Facebook .
Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить, дополнить или усовершенствовать нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]