Excel表如何拆分成多個表，每個表3000數據

 

按住alt依次按f11,i,m.
粘貼下面代碼後按f5,會在該目錄下得到拆分後的文件.


Sub test()
Application.ScreenUpdating = False
p = ThisWorkbook.Path & "\"
With ActiveSheet
For r = 1 To .Range("a1048576").End(xlUp).Row Step 3000
Set wb = Workbooks.Add
.Rows(r).Resize(3000).Copy wb.Sheets(1).Cells(1)
wb.SaveAs p & r & ".xls", xlNormal
wb.Close
Next
End With
Application.ScreenUpdating = True
End Sub