Vba 根据特定规则复制行块

长期读者，第一次海报。我已经用尽了我的研究技能，需要一些专家的帮助

我有一个电子表格，我们用它来记录位置，最多50000个位置，然后上传到一个独立的系统中。上传无法处理xlsm，所以我需要将其复制到一个新的工作表中，我已经完成了。但是，它也不能同时处理5000条以上的记录，所以

我需要修改我的vba以查看xlsm表上有多少条记录，并复制前5000条记录，然后复制第二5000条记录，如果需要，依此类推。 该公式计算了5000个区块的数量：

=CEILING(COUNTA(Table1[Country Name])/5000,1)

这是vba目前的工作范围不到5000：

Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Sheet1").Select
Application.CutCopyMode = False
Sheets("Sheet1").Move
Sheets("Sheet1").Select

我仍然是vba的基本用户，所以我的很多vba代码都是从这个网站和其他网站上的许多帖子中拼凑而成的

提前感谢你的帮助

---

彩信只需复制整个工作表即可。右键单击工作表->选择移动或复制。。然后选择要复制的工作簿。

难道不能在新工作簿中创建工作表，每个工作表包含5000行的批次，然后一次导出一张工作表吗

下面的代码是一个示例，说明了如何做到这一点。注意，其中没有错误处理，因此您需要确保1两个工作簿在同一应用程序中打开，2原始数据与VBA在同一工作簿中，3原始数据表中有数据

Const OUTPUT_BOOK_NAME As String = "OutputBook.xlsx" 'rename to your workbook
Const RAWDATA_SHEET_NAME As String = "Sheet1" 'rename to your sheet
Const START_ROW As Long = 3 'ammend row ref if different
Const MAX_RECORDS As Integer = 5000

Dim outputBook As Workbook
Dim outputSht As Worksheet
Dim rawdataSht As Worksheet
Dim endRow As Long
Dim endCol As Long
Dim iterations As Integer
Dim i As Integer
Dim r As Long
Dim v As Variant

'Check the output workbook is open
Set outputBook = Workbooks(OUTPUT_BOOK_NAME)

'Find worksheet limits
Set rawdataSht = ThisWorkbook.Worksheets(RAWDATA_SHEET_NAME)
endRow = rawdataSht.Cells.Find(What:="*", _
                               After:=rawdataSht.Cells(1), _
                               Lookat:=xlPart, _
                               LookIn:=xlFormulas, _
                               SearchOrder:=xlByRows, _
                               SearchDirection:=xlPrevious, _
                               MatchCase:=False).Row

endCol = rawdataSht.Cells.Find(What:="*", _
                               After:=rawdataSht.Cells(1), _
                               Lookat:=xlPart, _
                               LookIn:=xlFormulas, _
                               SearchOrder:=xlByColumns, _
                               SearchDirection:=xlPrevious, _
                               MatchCase:=False).Column

'Round up number of splits in data required.
iterations = -Int((endRow - START_ROW) / -MAX_RECORDS)

'Copy batches of 5000 to the next workbook
For i = 0 To iterations - 1
    r = i * MAX_RECORDS + START_ROW
    v = rawdataSht.Cells(r, 1).Resize(MAX_RECORDS, endCol).Value2
    Set outputSht = outputBook.Worksheets.Add(After:=outputBook.Worksheets(outputBook.Worksheets.Count))
    outputSht.Name = CStr(i * MAX_RECORDS + 1) & " - " & CStr((i + 1) * MAX_RECORDS)
    outputSht.Cells(1, 1).Resize(MAX_RECORDS, endCol).value = v
Next

---

您是否可以将其保存为.xlsx工作簿？