Sub SplitWorkbook()
Dim SourceSheet As Worksheet
Set SourceSheet = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name
Dim CurrentRow As Long
Dim StartRow As Long
Dim EndRow As Long
Dim TargetWorkbook As Workbook
Dim TargetSheet As Worksheet
Dim Index As Integer
CurrentRow = 2 ' Assuming row 1 has headers
StartRow = 2
Index = 1
While CurrentRow <= SourceSheet.UsedRange.Rows.Count
Set TargetWorkbook = Application.Workbooks.Add
Set TargetSheet = TargetWorkbook.Sheets(1)
If CurrentRow + 499 > SourceSheet.UsedRange.Rows.Count Then
EndRow = SourceSheet.UsedRange.Rows.Count
Else
EndRow = CurrentRow + 499
End If
SourceSheet.Rows(1).Copy TargetSheet.Rows(1)
SourceSheet.Rows(StartRow & ":" & EndRow).Copy TargetSheet.Rows(2)
TargetWorkbook.SaveAs "D:\Temp\File_" & Index & ".xlsx" ' change the file path as needed
TargetWorkbook.Close SaveChanges:=True
CurrentRow = EndRow + 1
StartRow = CurrentRow
Index = Index + 1
Wend
End Sub
VBA一个sheet多行按照固定行数分割到多个excel中
最新推荐文章于 2024-06-05 13:13:54 发布
这段代码描述了一个VBA宏,用于将源工作簿中每500行数据分割到新创建的工作簿中,每个新工作簿保存为单独的Excel文件。
摘要由CSDN通过智能技术生成