代码错误，求修改

边缘码农

1. Sub SplitDataIntoNewWorkbooks()
   
2.     Dim wbSource As Workbook
   
3.     Dim wsSource As Worksheet
   
4.     Dim wbTarget As Workbook
   
5.     Dim wsTarget As Worksheet
   
6.     Dim lastRow As Long
   
7.     Dim rowCounter As Long
   
8.     Dim fileCounter As Long
   
9.     Dim targetRow As Long
   
10.     Dim dateStr As String
    
11.     Dim targetName As String
    
12.     Dim fileTotal As Long
    
13.     Dim rowRemainder As Long
    
14.    
    
15.     ' 设置源工作簿和工作表
    
16.     Set wsSource = Sheets("批量下拨")
    
17.    
    
18.     ' 获取源工作表中的最后一行
    
19.     lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
20.    
    
21.     ' 初始化计数器
    
22.     fileCounter = 1  ' 生成的文件数量
    
23.     rowCounter = 2 '复制数据的开始行数
    
24.     targetRow = 2 '粘贴数据的开始行数
    
25.     fileTotal = Int((lastRow - 1) / 20)   '要复制的文件数量，当除不尽时，是实际数量-1
    
26.     rowRemainder = (lastRow - 1) Mod 20   ' 取得不足20行的剩余行数
    
27.    
    
28. 
    
29.     ' 获取当前日期字符串
    
30.     dateStr = Format(Now, "yyyy-mm-dd")
    
31.    
    
32.     ' 循环处理数据，每20行创建一个新工作簿
    
33.     Do While fileCounter <= fileTotal
    
34.         ' 创建新工作簿
    
35.         Set wbTarget = Workbooks.Add
    
36.         Set wsTarget = wbTarget.Sheets(1)
    
37.         
    
38.         ' 设置新工作簿的名称为当前日期加上序号
    
39.         targetName = "批量下拨_" & dateStr & "_" & fileCounter & ".xlsx"
    
40.         wbTarget.SaveAs Filename:=ThisWorkbook.Path & "" & targetName
    
41.         
    
42.         ' 复制第一行到新工作簿
    
43.         wsSource.Rows(1).Copy Destination:=wsTarget.Rows(1)
    
44.         
    
45.         ' 复制后续的20行数据到新工作簿
    
46.         wsSource.Range(wsSource.Cells(rowCounter, 1), wsSource.Cells(rowCounter + 19, wsSource.Columns.Count)).Copy _
    
47.             Destination:=wsTarget.Range(wsTarget.Cells(targetRow, 1), wsTarget.Cells(targetRow + 19, wsSource.Columns.Count))
    
48.         
    
49.         ' 更新计数器和行号
    
50.         rowCounter = rowCounter + 20
    
51.         'targetRow = targetRow + 20
    
52.         fileCounter = fileCounter + 1
    
53.         wbTarget.Save
    
54.         'wbTarget.Close '需要自动关闭时，可以使用这一句
    
55.     Loop
    
56.    
    
57.     ' 如果最后一组数据不足20行，也需要复制
    
58.     If rowRemainder > 0 Then
    
59.         Set wbTarget = Workbooks.Add
    
60.         Set wsTarget = wbTarget.Sheets(1)
    
61.         
    
62.         ' 设置新工作簿的名称为当前日期加上序号
    
63.         targetName = "批量下拨_" & dateStr & "_" & fileCounter & ".xlsx"
    
64.         wbTarget.SaveAs Filename:=ThisWorkbook.Path & "" & targetName
    
65.         
    
66.         ' 复制第一行到新工作簿
    
67.         wsSource.Rows(1).Copy Destination:=wsTarget.Rows(1)
    
68.         
    
69.         ' 复制剩余的数据到新工作簿
    
70.         wsSource.Range(wsSource.Cells(rowCounter, 1), wsSource.Cells(rowCounter + 19, wsSource.Columns.Count)).Copy _
    
71.             Destination:=wsTarget.Range(wsTarget.Cells(targetRow, 1), wsTarget.Cells(targetRow + 19, wsSource.Columns.Count))
    
72.         wbTarget.Save
    
73.         'wbTarget.Close '需要自动关闭时，可以使用这一句
    
74.     End If
    
75.    
    
76.     ' 清理
    
77.     Set wsSource = Nothing
    
78.     Set wsTarget = Nothing
    
79.     Set wbTarget = Nothing
    
80.     Set wbSource = Nothing
    
81. End Sub

复制代码

ykcbf1100

施学明 发表于 2024-8-1 15:14
运行错误1004，无法访问文件

你用AI写的代码来让别人修改，那其实不太合适，AI的思维与人类不太一样。
你还是说明需求，重新写一个更好。

施学明

ykcbf1100 发表于 2024-8-1 20:54
你用AI写的代码来让别人修改，那其实不太合适，AI的思维与人类不太一样。
你还是说明需求，重新写一个更 ...

谢谢指导与帮助