Excel 宏每 n 行创建一个新工作表

Question

我正在尝试编写一个宏来获取数千行的 Excel 文件，并将初始工作表的行拆分为每张 250 行的工作表，不包括原始标题行，也应复制到每张纸上。总共 13 列，部分字段为空。

我可以自己对文档进行排序 - 这不是问题 - 我只是没有宏观技能来解决这个问题。

我尝试过搜索，找到了一些例子，但没有一个很合适..比如这个.. create macro that will convert excel rows from single sheet to new sheets ..或者这个.. Save data input from one sheet onto successive rows in another sheet

有什么帮助吗？

Answer 1

这也应该提供您正在寻找的解决方案。您实际上是在我输入时添加了答案，但也许有人会发现它有用。

此方法仅要求您输入要复制到每个页面的行数，并假设执行该方法后您位于“主”页面。

Sub AddSheets()
Application.EnableEvents = False

Dim wsMasterSheet As Excel.Worksheet
Dim wb As Excel.Workbook
Dim sheetCount As Integer
Dim rowCount As Integer
Dim rowsPerSheet As Integer

Set wsMasterSheet = ActiveSheet
Set wb = ActiveWorkbook

rowsPerSheet = 5
rowCount = Application.CountA(Sheets(1).Range("A:A"))
sheetCount = Round(rowCount / rowsPerSheet, 0)

Dim i As Integer

For i = 1 To sheetCount - 1 Step 1
With wb
    'Add new sheet
    .Sheets.Add after:=.Sheets(.Sheets.Count)

     wsMasterSheet.Range("A1:M1").EntireRow.Copy Destination:=Sheets(.Sheets.Count).Range("A1").End(xlUp)       

    wsMasterSheet.Range("A" & (rowsPerSheet + 2) & ":M" & (2 * rowsPerSheet + 1)).EntireRow.Cut Destination:=Sheets(.Sheets.Count).Range("A" & Rows.Count).End(xlUp).Offset(1)
    wsMasterSheet.Range("A" & (rowsPerSheet + 2) & ":M" & (2 * rowsPerSheet + 1)).EntireRow.Delete

    ActiveSheet.Name = "Rows " + CStr(((.Sheets.Count - 1) * rowsPerSheet + 1)) & " - " & CStr((.Sheets.Count * rowsPerSheet))
End With


Next

wsMasterSheet.Name = "Rows 1 - " & rowsPerSheet

Application.EnableEvents = True

End Sub