来自每个薄片复制范围到在Microsoft Excel中使用VBA一个片
在本文中，我们将创建一个宏以将数据从工作簿中的所有工作表复制到新工作表。
此示例的原始数据由不同工作表中不同部门的员工详细信息组成。我们希望将员工详细信息整合到一个表中。
我们创建了“ CopyRangeFromMultipleSheets”宏来合并数据。单击“合并数据”按钮可以运行此宏。
宏将创建一个新的工作表，并插入所有工作表中的合并数据。
代码说明
“遍历”所有工作表以检查是否存在“主”工作表。
对于ThisWorkbook.Worksheets中的每个源如果Source.Name =“ Master”，则MsgBox“ Master表已存在”
如果下一个上面的代码，退出子结束，用于检查工作簿中是否存在“母版”表。如果工作簿中存在“母版”表，则代码将退出并显示错误消息。
Source.Range（“ A1”）。SpecialCells（xlLastCell）.Row上面的代码用于获取工作表中最后一个单元格的行号。
Source.Range（“ A1”，Range（“ A1”）。SpecialCells（xlLastCell））。Copy Destination.Range（“ A”＆DestLastRow）
上面的代码用于将指定范围复制到定义的单元格。
请遵循以下代码
Sub CopyRangeFromMultipleSheets()
'Declaring variables
Dim Source As Worksheet
Dim Destination As Worksheet
Dim SourceLastRow, DestLastRow As Long
Application.ScreenUpdating = False
'Looping through all sheets to check whether "Master" sheet exist
For Each Source In ThisWorkbook.Worksheets
If Source.Name = "Master" Then
MsgBox "Master sheet already exist"
Exit Sub
End If
Next
'Inserting a new sheet after the "Main" sheet
Set Destination = Worksheets.Add(after:=Sheets("Main"))
Destination.Name = "Master"
'Looping through all the sheets in the workbook
For Each Source In ThisWorkbook.Worksheets
'Preventing consolidation of data from "Main" and "Master" sheet
If Source.Name <> "Main" And Source.Name <> "Master" Then
SourceLastRow = Source.Range("A1").SpecialCells(xlLastCell).Row
Source.Activate
If Source.UsedRange.Count > 1 Then
DestLastRow = Sheets("Master").Range("A1").SpecialCells(xlLastCell).Row
If DestLastRow = 1 Then
'copying data from the source sheet to destination sheet
Source.Range("A1", Range("A1").SpecialCells(xlLastCell)).Copy Destination.Range("A" & DestLastRow)
Else
Source.Range("A2", Range("A1").SpecialCells(xlCellTypeLastCell)).Copy Destination.Range("A" & (DestLastRow + 1))
End If
End If
End If
Next
Destination.Activate
Application.ScreenUpdating = True
End Sub
如果您喜欢此博客，请在Facebook和Facebook上与您的朋友分享。
我们很希望收到您的来信，请让我们知道我们如何才能改善我们的工作并使您的工作更好。写信给我们[email protected]