我有一堆始终具有相同工作表的数据集。
现在我想为每个工作表制作一个不同的文件。我发现了一些代码可以做到这一点:http ://www.extendoffice.com/documents/excel/628-excel-split-workbook.html#kutools
但是,我也只想要这些工作表的前三列,最好总是从第 2 行开始。
有人可以指出我正确的方向。例如关于如何更改我发布的代码。
我有一堆始终具有相同工作表的数据集。
现在我想为每个工作表制作一个不同的文件。我发现了一些代码可以做到这一点:http ://www.extendoffice.com/documents/excel/628-excel-split-workbook.html#kutools
但是,我也只想要这些工作表的前三列,最好总是从第 2 行开始。
有人可以指出我正确的方向。例如关于如何更改我发布的代码。
试试下面的代码:
Sub Splitbook()
Application.ScreenUpdating = False
Dim myPath As String
Dim rng As Range
Dim sht As Worksheet
Dim lastRow As Long
Dim wkb As Workbook
For Each sht In ThisWorkbook.Sheets
lastRow = sht.Range("A6500").End(xlUp).Row
If lastRow < 2 Then GoTo nextSht
Set rng = sht.Range("A2:C" & lastRow)
If Not rng Is Nothing Then
Set wkb = Workbooks.Add
rng.Copy wkb.Sheets(1).Range("A2")
myPath = filePath(sht.Name)
wkb.SaveAs Filename:=myPath
wkb.Close
Set wkb = Nothing
Set rng = Nothing
End If
nextSht:
Next
Application.ScreenUpdating = True
End Sub
Function filePath(worksheetname As String) As String
Dim fso As Object, MyFolder As String
Set fso = CreateObject("Scripting.FileSystemObject")
MyFolder = ThisWorkbook.Path & "\Reports"
If fso.FolderExists(MyFolder) = False Then
fso.CreateFolder (MyFolder)
End If
MyFolder = MyFolder & "\" & Format(Now(), "MMM_YYYY")
If fso.FolderExists(MyFolder) = False Then
fso.CreateFolder (MyFolder)
End If
filePath = MyFolder & "\" & worksheetname & Format(Now(), "DD-MM-YY hh.mm.ss") & ".xlsx"
Set fso = Nothing
End Function