给大家一段代码，猜猜这个是干什么用的？
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next '当程序出错时候，继续执行下一句
    Arr = [A1].CurrentRegion
    For i = 4 To UBound(Arr)
        Sheets("sheet2").Copy
        With ActiveWorkbook.Sheets(1)
            .[B2] = Trim(Arr(i, 3))
            .[D2] = Arr(i, 2)
            .[B3] = Arr(i, 6) & "人"
            .[D3] = Arr(i, 5)
            .[D5].Resize(13, 1) = Application.Transpose(Application.Index(Array(Arr(i, 7), Arr(i, 8), Arr(i, 9), Arr(i, 10), Arr(i, 11), Arr(i, 12), Arr(i, 13), Arr(i, 14), Arr(i, 15), Arr(i, 16), Arr(i, 17), Arr(i, 18), Arr(i, 19)), 0))
        End With
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Trim(Arr(i, 3)) & "（" & Arr(i, 5) & "）" & ThisWorkbook.Name & ".xls"
        'ActiveWorkbook.PrintOut
        ActiveWorkbook.Close
    Next
    Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

代码给大家，有兴趣地测试下，还原数据模型。

温馨提示：这段代码没有在以往我发布的帖子出现，代码虽简短，但是实现的功能非常强大！