工作表按某列标识分别截成多个EXCEL sheet

将下面的方法放于VBA中执行即可

注：需要有工作表Name为Sheet1,

 使用的对象参考：http://zhucongg.blog.163.com/blog/static/1148148320153742843347/

 

Sub s()

  Application.ScreenUpdating = False

  Dim sh As Worksheet, i As Integer

    For i = 2 To Sheet1.[a65536].End(3).Row

      If Sheet1.Cells(i, 1) <> Sheet1.Cells(i - 1, 1) Then

        Worksheets.Add after:=Worksheets(Sheets.Count)

          Set sh = ActiveSheet

            sh.Name = Sheet1.Cells(i, 1)

            sh.Range("a1").Resize(1, 3).Value = Sheet1.Range("a1").Resize(1, 3).Value

            sh.Range("a65536").End(3).Offset(1, 0).Resize(1, 3).Value = Sheet1.Cells(i, 1).Resize(1, 3).Value

          Else

            sh.Range("a65536").End(3).Offset(1, 0).Resize(1, 3).Value = Sheet1.Cells(i, 1).Resize(1, 3).Value

      End If

    Next i

Application.ScreenUpdating = True

End Sub