表格分割

sea8523

有一个表格，前3行是标题行，从第4行开始 每100行生成一个新的sheet，该如何操作


通过ai 写的vba代码报错，现在不知道 哪块有问题 请大神看看

1. Sub SplitDataIntoSheets()
   
2.     Dim originalSheet As Worksheet
   
3.     Set originalSheet = ThisWorkbook.Worksheets("原始数据") ' 修改为您的原始数据工作表名称
   
4.    
   
5.     Dim rowCount As Long, row As Long
   
6.     Dim sheetCount As Long, startRow As Long
   
7.     Dim headers As Range, currentSheet As Worksheet
   
8.    
   
9.     ' 设置此变量以指定每个新sheet的数据行数（不含标题）
   
10.     Const maxRowsPerSheet As Long = 100
    
11.    
    
12.     rowCount = originalSheet.Cells(originalSheet.Rows.Count, 1).End(xlUp).row ' 获取原始数据的总行数
    
13.    
    
14.     ' 分割后的sheet数
    
15.     sheetCount = 0
    
16.    
    
17.     ' 从第4行开始，因为前三行是标题行
    
18.     For row = 4 To rowCount Step maxRowsPerSheet
    
19.         sheetCount = sheetCount + 1
    
20.         ' 创建新的工作表
    
21.         Set currentSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets))
    
22.         currentSheet.Name = "Sheet_" & sheetCount ' 命名新的工作表
    
23.         
    
24.         ' 复制标题行
    
25.         originalSheet.Rows("1:3").Copy Destination:=currentSheet.Rows("1:3")
    
26.         
    
27.         ' 计算当前块的起始和结束行
    
28.         startRow = row
    
29.         If startRow + maxRowsPerSheet - 1 <= rowCount Then
    
30.             ' 复制当前区块的数据
    
31.             originalSheet.Rows(startRow &amp; ":" &amp; startRow + maxRowsPerSheet - 1).Copy Destination:=currentSheet.Rows("4")
    
32.         Else
    
33.             ' 复制最后一个区块的数据（可能不满maxRowsPerSheet行）
    
34.             originalSheet.Rows(startRow &amp; ":" &amp; rowCount).Copy Destination:=currentSheet.Rows("4")
    
35.         End If
    
36.     Next row
    
37.    
    
38.     MsgBox sheetCount & " sheets have been created successfully.", vbInformation
    
39. End Sub
    
40. 
    

复制代码

红色部分为 代码错误部分

3190496160

Sub 拆分()
Application.ScreenUpdating = False
Dim sh As Worksheet, sht As Worksheet
Application.DisplayAlerts = False
For Each sh In Sheets
    If sh.Index > 1 Then
        sh.Delete
    End If
Next sh
Application.DisplayAlerts = True
Set sh = ActiveSheet
r = sh.Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To r Step 100
    m = m + 1
    Set sht = Worksheets.Add(after:=Sheets(Sheets.Count))
    With sht
        .Name = m
        sh.Rows("1:3").Copy .[a1]
        sh.Rows(i & ":" & i + 99).Copy .[a4]
    End With
Next i
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

sea8523

3190496160 发表于 2024-7-13 10:09
Sub 拆分()
Application.ScreenUpdating = False
Dim sh As Worksheet, sht As Worksheet

感谢大佬！！！