여러 장을 하나의 통합 문서로 복사

Question

extendoffice 웹 사이트에서이 코드를 발견했습니다. 그러나 그것은 내가 시트와 관련이있는 것을 충족시키지 못합니다. 나는 또한 불행하게도 여기에서 검색을한다. 그것은 나의 요구 사항을 충족시키지 못한다.

아래 코드는 훌륭하게 작동하지만 각 워크 시트는 개별 통합 문서로 저장됩니다. 기본적으로 나는 내 주요 통합 문서에 4 장이 있습니다. 결과적으로 각 시트를 하나의 통합 문서로 저장합니다. 나는 그것을 (폴더에 저장하는) 동일하게하고 싶었지만 워크 시트는 하나의 워크 북에 저장해야했습니다.

Sub ExportSheets() 

Dim wb As Workbook, InitFileName As String, fileSaveName As String 

InitFileName = ThisWorkbook.Path & "\Reminder " & Format(Date, "yyyymmdd") 


    Sheets(Array("SheetName1", "SheetName2", "SheetName3", "SheetName4")).Copy 

Set wb = ActiveWorkbook 

fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitFileName, _ 
filefilter:="Excel files , *.xlsx") 

With wb 
    If fileSaveName <> "False" Then 

     .SaveAs fileSaveName 
     .Close 
    Else 
     .Close False 
     Exit Sub 
    End If 
End With 

End Sub 

:

Sub SplitWorkbook() 

Dim FileExtStr As String 
Dim FileFormatNum As Long 
Dim xWs As Worksheet 
Dim xWb As Workbook 
Dim FolderName As String 
Application.ScreenUpdating = False 
Set xWb = Application.ThisWorkbook 
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss") 
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString 
MkDir FolderName 
For Each xWs In xWb.Worksheets 
xWs.Copy 
If Val(Application.Version) < 12 Then 
    FileExtStr = ".xls": FileFormatNum = -4143 
Else 
    Select Case xWb.FileFormat 
     Case 51: 
      FileExtStr = ".xlsx": FileFormatNum = 51 
     Case 52: 
      If Application.ActiveWorkbook.HasVBProject Then 
       FileExtStr = ".xlsm": FileFormatNum = 52 
      Else 
       FileExtStr = ".xlsx": FileFormatNum = 51 
      End If 
     Case 56: 
      FileExtStr = ".xls": FileFormatNum = 56 
     Case Else: 
      FileExtStr = ".xlsb": FileFormatNum = 50 
    End Select 
End If 
xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr 
Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum 
Application.ActiveWorkbook.Close False 
Next 
MsgBox "You can find the files in " & FolderName 
Application.ScreenUpdating = True 
End Sub 

Answer 1

은 내가 아래의 코드를 필요 얻을 수있었습니다