다른 워크 시트의 첫 번째 3 열을 단일 파일로 복사

Question

나는 항상 동일한 워크 시트를 사용하여 많은 데이터 세트를 가지고 있습니다.

이제 각 워크 시트마다 다른 파일을 만들고 싶습니다. http://www.extendoffice.com/documents/excel/628-excel-split-workbook.html#kutools

그러나, 나는 또한 만 워크 시트의 처음 세 열을 원하고 바람직하게는 항상

누군가가 올바른 방향으로 날 지점 수 행 2. 시작 : 난 그냥 그 작업을 수행하는 코드를 발견했다. 예 : 내가 게시 한 코드를 변경하는 방법. 코드 아래

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