Excel应用实践08：从主表中将满足条件的数据分别复制到其他多个工作表中

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