如何将大型Excel工作表分成多个工作表

时间:2015-02-06 11:01:13

标签: vba excel-vba excel

我有大量的excel表格,其中16k记录我要将其分成多张表格,如1张excel表格中的2000条记录,如果有任何想法,那么它应该在下一页中添加,请帮我解决这个问题。< / p>

非常感谢 Vijay Bhatt

1 个答案:

答案 0 :(得分:0)

我不知道您对VBA了解多少,但您可以使用以下代码来实现您的目标。我会发布2个选项。第一个宏将删除从源表复制的行,第二个宏将保留源表值。您需要做的就是使用源工作表的名称更新代码以及在每个生成的工作表中需要多少行。

更新项目

Set CWS = Sheets("Sheet2") 'Source Worksheet name
LineNo = 5 ' Number of lines in each sheet

宏1:将从源表中删除复制的行。

Dim CWS As Worksheet
Dim LastRow As Long
Dim S_No As Long
Dim LineNo As Long

Set CWS = Sheets("Sheet2") 'Source Worksheet name
LastRow = Range("A" & Rows.Count).End(xlUp).Row
LineNo = 5 ' Number of lines in each sheet including header
S_No = 1

i = 1
While i < LastRow
    CWS.Range("1:" & LineNo).Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Partition " & S_No
    Sheets("Partition " & S_No).Range("A1").PasteSpecial
    CWS.Range("2:" & LineNo).Delete Shift:=xlUp
    LastRow = CWS.Range("A" & Rows.Count).End(xlUp).Row
    S_No = S_No + 1
Wend

宏2:将在源表中保留复制的行。

Dim CWS As Worksheet
Dim LastRow As Long
Dim S_No As Long
Dim LineNo As Long

Set CWS = Sheets("Sheet2") 'Source Worksheet name
LastRow = Range("A" & Rows.Count).End(xlUp).Row
LineNo = 5  ' Number of lines in each sheet excluding header
S_No = 1

For i = 2 To LastRow
    CWS.Range("1:1," & i & ":" & i + LineNo - 1).Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Partition " & S_No
    Sheets("Partition " & S_No).Range("A1").PasteSpecial
    i = i + Sheets("Partition " & S_No).Range("A" & Rows.Count).End(xlUp).Row - 1
    S_No = S_No + 1
Next

更新:我更新了代码,将第一行作为标题复制到所有创建的工作表中。但请阅读LineNo变量旁边的评论。