每个片材的单元的CurrentRegion复制到在Microsoft Excel中使用VBA一个片
| _如果要一次处理多个工作表，并且要将每张工作表中的数据复制到主工作表中，则应该阅读本文。我们将使用VBA代码的currentregion属性将所有工作表中的数据合并到一个工作表中。对于许多自动扩展选择范围以包括整个当前区域的操作，此属性很有用，例如AutoFormat方法。 _
不能在受保护的工作表上使用此属性。条件是：每张工作表应包含相似的格式，即列数相同；使用相同的格式，我们可以准确地合并数据。
请注意：本文将演示如何使用VBA代码；如果由于任何原因一张纸中的列数不同，则整个合并的数据将无法提供准确的图像。强烈建议使用相同数量的列。 VBA代码将在工作簿中添加一个新工作表，然后将数据复制并粘贴到每个工作表之后，而不会覆盖。
让我们以3个工作表为例，即1月，2月和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]