Question

高分求excel自动分页储存宏

设一个表有选定的n行数据需要以行为基本单位转存，要求在同一个xls文档中往后每新建一页存数据，每页存放10条，第11条开始存放到再往后的新建页去，以此类推直到把第一个工作表的所有数据全部转存完。其中以c3行为判断，如果当前条的c3于上一条的不一样，也往后新建一页存放。

我不懂vb所以没有办法……
在线等高分求啊，如果成功实现的话一定加分！！

Answer 1

Sub test()
Dim ct, xct As Double
Dim stname As String
ct = ActiveSheet.Range("a65535").End(xlUp).Row
stname = ActiveSheet.name
xct = Round((ct / 10) + 0.4999)
For i = 1 To xct
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.name = i
For j = 1 To 10
Sheets(stname).Rows((i - 1) * 10 + j).Copy ActiveSheet.Rows(j)
Next j
Next i
End Sub

只能做到帮你做到自动分页,至于"其中以c3行为判断，如果当前条的c3于上一条的不一样，也往后新建一页存放"我看不明白,什么是C3行? C3不是单元格么?

Answer 2

按AIL+F11,打开VBA编辑器，菜单－插入－模块－右边空白处粘贴以下代码，按F5运行完成。

Sub Split()
Dim row As Integer
Dim ExcelLastCell As Range
Dim col As Integer
Dim numberofsheets As Integer
Dim j As Integer
Dim Wb As Workbook, sh As Worksheet
Set Wb = ActiveWorkbook
Set sh = Wb.Sheets("Sheet1")
Set ExcelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
col = ExcelLastCell.Column
row = ExcelLastCell.row
numberofsheets = WorksheetFunction.RoundUp((row - 1) / 10, 0)
For j = 1 To numberofsheets
Sheets.Add.Name = "Newsheet" & j
sh.Range("A1").EntireRow.Copy Destination:=Sheets("newsheet" & j).Range("A1")
sh.Range("a" & ((j - 1) * 10 + 2) & ":a" & (j * 10 + 1)).EntireRow.Copy Destination:=Sheets("newsheet" & j).Range("A2")
Next
End Sub

Answer 3

发个测试用文件过来,我帮你做
guangjingyu@gmail.com