将不同工作表的前3列复制到单个文件中

我有一堆总是相同的工作表数据集。

现在我想为每个工作表创build一个不同的文件。 我发现了一些代码，只是： http : //www.extendoffice.com/documents/excel/628-excel-split-workbook.html#kutools

不过，我也只想要这些工作表的前三列，最好总是从第二行开始。

有人能指出我正确的方向吗？ 例如，如何更改我发布的代码。

Answer 1

尝试下面的代码：

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