1

常に同じワークシートを持つデータセットがたくさんあります。

次に、ワークシートごとに異なるファイルを作成します。私はまさにそれを行ういくつかのコードを見つけました：http：//www.extendoffice.com/documents/excel/628-excel-split-workbook.html#kutools

ただし、これらのワークシートの最初の3列のみが必要であり、できれば常に行2から開始することもできます。

誰かが私を正しい方向に向けることができますか。たとえば、投稿したコードを変更する方法について。

4

1 に答える 1

0

以下のコードを試してください：

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
于 2013-03-20T17:56:01.420 に答える