EXCEL一个表单中表格如何分多表单？

小NN

如题
EXCEL一个表单中有多个表格，比如1到10行一个表格，11行到20行一个表格……表格格式类型都一样，如何拆分为分多表单，每个表单一个表格？

loirol

ykcbf1100

原格式拆分
附件供参考。。。

ykcbf1100

按10行拆分为多表，原格式

1. Sub ykcbf()   '//2024.12.23   按10行拆分多工作表
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     p = ThisWorkbook.Path & ""
   
5.     rr = 10    '//按10行拆分
   
6.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
7.     For Each sht In Sheets
   
8.         If sht.Name <> sh.Name Then sht.Delete
   
9.     Next
   
10.     With sh
    
11.         r = .UsedRange.Find("*", , -4163, , 1, 2).Row
    
12.         c = .UsedRange.Columns.Count
    
13.         arr = .[a1].Resize(r, c)
    
14.         Set bth = .Rows(1).EntireRow
    
15.     End With
    
16.     For i = 1 To UBound(arr) Step rr
    
17.         k = k + 1
    
18.         Set sht = Sheets.Add(After:=Sheets(Sheets.Count))
    
19.         With sht
    
20.             .Name = k
    
21.             .DrawingObjects.Delete
    
22.             bth.Copy .[a1]
    
23.             sh.Rows(i).Resize(rr, c).Copy .[a1]
    
24.         End With
    
25.     Next
    
26.     sh.Activate
    
27.     Application.ScreenUpdating = True
    
28.     MsgBox "OK！"
    
29. End Sub
    

复制代码

gwjkkkkk

gwjkkkkk

参与一下。。。
Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, r&, rngData As Range, wks As Worksheet
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    With Worksheets(1)
        For Each wks In Worksheets
            If wks.Name <> .Name Then wks.Delete
        Next
        ar = .UsedRange.Value
        For i = 1 To UBound(ar) Step 10
            Set rngData = Range(.Cells(i, 1), .Cells(i + 9, UBound(ar, 2)))
            With Worksheets.Add(after:=Worksheets(Worksheets.Count))
                rngData.Copy .[A1]
            End With
        Next i
    End With
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Beep
End Sub