Question

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

我有一个电子表格，用于记录位置（最多50,000个），以便上传到独立系统。上传无法应付xlsm所以我需要将其复制到一个新的工作表（我已经完成）但是，它也无法一次处理超过5,000条记录所以......

我需要修改我的vba来查看xlsm工作表上有多少条记录，然后复制前5,000条，然后复制第二条5000条等等。如果需要的话。这个公式计算了5,000个区块的数量：

=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代码都是通过本网站和其他网站上发现的众多帖子拼凑而成的。

提前感谢您的帮助。

MMS

Answer 1

只需复制整个工作表即可。右键单击您的工作表 - ＆gt;选择移动或复制..然后选择您想要复制的工作簿。

Answer 2

难道你不能只在新工作簿中创建工作表，每个工作表包含5,000行的批次，然后一次导出一个工作表吗？

以下代码是您如何做到这一点的示例。请注意，其中没有错误处理，因此您需要确保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

根据特定规则复制行块

2 个答案: