将满足条件的excel数据分别复制到其他多个工作表中 _知识经验

以前也经常遇到类似问题，并且其解决技巧很有效率，因此在这里和大家分享。
如下所示的工作表，在主工作表MASTER中存放着从数据库下载的全部数据。现在，要根据列E中的数据将前12列的数据分别复制到其他工作表中，其中，列E中数据开头两位数字是61的单元格所在行前12列数据复制到工作表61中，开头数字是62的单元格所在行前12列数据复制到工作表62中，同样，开头数字是63的复制到工作表63中，开头数字是64或65的复制到工作表64_65中，开头数字是68的复制到工作表68中。

文章插图
用来完成上述工作的VBA代码如下：
Sub MasterDataToSheets()
Dim x
Dim i As Long
Dim ii As Long
Dim i61 As Integer
Dim i62 As Integer
Dim i63 As Integer
Dim i6465 As Integer
Dim i68 As Integer
‘选择前12列数据并赋给数组
x = Sheet1.Cells(1).CurrentRegion.Resize(,12)
‘重新定义数组大小
ReDim Data61(1 To UBound(x, 1), 1 To 12)
ReDim Data62(1 To UBound(x, 1), 1 To 12)
ReDim Data63(1 To UBound(x, 1), 1 To 12)
ReDim Data6465(1 To UBound(x, 1), 1 To 12)
ReDim Data68(1 To UBound(x, 1), 1 To 12)
‘遍历数据并将第5列符合条件的数据存储到相应的数组中
For i = 2 To UBound(x, 1)
Select Case Left(x(i, 5), 2)
Case 61
i61 = i61 + 1
For ii = 1 To 12
Data61(i61, ii) = x(i, ii)
Next
Case 62
i62 = i62 + 1
For ii = 1 To 12
Data62(i62, ii) = x(i, ii)
Next
Case 63
i63 = i63 + 1
For ii = 1 To 12
Data63(i63, ii) = x(i, ii)
Next
Case 64, 65
i6465 = i6465 + 1
For ii = 1 To 12
Data6465(i6465, ii) = x(i,ii)
Next
Case 68
i68 = i68 + 1
For ii = 1 To 12
Data68(i68, ii) = x(i, ii)
Next
End Select
Next
‘关闭屏幕更新
Application.ScreenUpdating = False
‘更新工作表61中的数据
WithSheets(“61”).Cells(1).CurrentRegion
‘清除原有内容，标题行除外
.Offset(1).Resize(.Rows.Count,12).ClearContents
‘从单元格A2开始输入数据
.Parent.[A2].Resize(UBound(Data61, 1),12) = Data61
End With
‘更新工作表62中的数据
WithSheets(“62”).Cells(1).CurrentRegion
.Offset(1).Resize(.Rows.Count, 12).ClearContents
.Parent.[A2].Resize(UBound(Data62, 1),12) = Data62
End With
‘更新工作表63中的数据
WithSheets(“63”).Cells(1).CurrentRegion
.Offset(1).Resize(.Rows.Count,12).ClearContents
.Parent.[A2].Resize(UBound(Data63, 1), 12)= Data63
End With
‘更新工作表64、65中的数据
WithSheets(“64_65”).Cells(1).CurrentRegion
.Offset(1).Resize(.Rows.Count,12).ClearContents
.Parent.[A2].Resize(UBound(Data6465,1), 12) = Data6465
End With
‘更新工作表68中的数据
WithSheets(“68”).Cells(1).CurrentRegion
.Offset(1).Resize(.Rows.Count,12).ClearContents
.Parent.[A2].Resize(UBound(Data68, 1),12) = Data68
End With
‘开启屏幕更新
Application.ScreenUpdating = True
‘提示用户更新数据已完成
MsgBox “所有工作表都已更新!”, 64, “已完成”
End Sub
运行代码后，工作表61中的数据如下所示。