여러 워크 시트의 새 통합 문서에만 값 복사

Question

workbook1.xlsm에 여러 워크 시트가 있고 다양한 수식으로 가득 찬 것으로 가정합니다. 이 정확히 일 때 workbook1과 같지만 모든 셀에서 수식 대신 값이 될 새 workbook2.xlsx을 만들고 싶습니다.

Sub nowe() 

Dim Output As Workbook 
Dim FileName As String 

Set Output = Workbooks.Add 
Application.DisplayAlerts = False 

ThisWorkbook.Worksheets("Przestoje").Cells.Copy 

Selection.PasteSpecial Paste:=xlPasteValues, _ 
Operation:=xlNone, SkipBlanks:=True, Transpose:=False 

Selection.PasteSpecial Paste:=xlPasteFormats 

FileName = ThisWorkbook.Path & "\" & "worksheet2.xlsx" 
Output.SaveAs FileName 

End Sub 

을하지만 문제는 사본에게 그것을 하나의 워크 시트를하고는 worksheet1에 있었다처럼 이름을하지 않습니다

나는 workbook1에서 한 장을 복사하려면이 매크로를 가지고있다. 나는 그것을 이해할 수 없다.

또 다른 문제는 나중에 worksheet2이 열리고 있다는 것입니다. 나는 이것을하고 싶지 않다.

어떻게 이러한 문제를 해결할 수 있습니까? 이 같은

Answer 1

새로운 통합 문서를 만들고 시트를 복사하지 않고 간단하게 처리합니다.

몇 가지 간단한 단계 : taking into consideration thisworkbook >> for each worksheet within thisworkbook >> copy+paste values of used range within worksheet >> save as new workbook as xlsx type >> open back base workbook >> and finally close one we created.

다음과 같이 코드가 간단하고 보이는 것은 :

Sub nowe_poprawione() 

    Dim Output As Workbook 
    Dim Current As String 
    Dim FileName As String 

    Set Output = ThisWorkbook 
    Current = ThisWorkbook.FullName 

    Application.DisplayAlerts = False 

    Dim SH As Worksheet 
    For Each SH In Output.Worksheets 

     SH.UsedRange.Copy 
     SH.UsedRange.PasteSpecial xlPasteValues, _ 
      Operation:=xlNone, SkipBlanks:=True, Transpose:=False 

    Next 

    FileName = ThisWorkbook.Path & "\" & "worksheet2.xlsx" 
    Output.SaveAs FileName, XlFileFormat.xlOpenXMLWorkbook 
    Workbooks.Open Current 
    Output.Close 
    Application.DisplayAlerts = True 
End Sub 

Answer 2

뭔가를 순환 작동하고 통합 문서를 추가 한 후 모든 시트를 복사합니다 :이 통합 문서가 만들어 질 경우 자동으로 생성 얻을 제거 기본 시트를 처리하지 않습니다

dim i as integer 
For i = 1 To ThisWorkbook.Worksheets.Count 

    ThisWorkbook.Worksheets(i).Activate 
    ThisWorkbook.Worksheets(i).Select 
    Cells.Copy 

    Output.Activate 

    Dim newSheet As Worksheet 
    Set newSheet = Output.Worksheets.Add() 
    newSheet.Name = ThisWorkbook.Worksheets(i).Name 

    newSheet.Select 
    Cells.Select 

    Selection.PasteSpecial Paste:=xlPasteValues, _ 
    Operation:=xlNone, SkipBlanks:=True, Transpose:=False 

Next 

참고. 이 같은

Output.Close 

Answer 3

뭔가 작동합니다 :

Set Output = Workbooks.Add 

을 그냥 저장 한 후 닫습니다 : 바로이 전화로 (SaveAs 때까지 이름이 아니지만) 또한

, worksheet2 실제로 개방되고있다 통합 문서를 추가 한 후 모든 시트를 순환하고 복사하려면 mr.Reband의 대답을 기반으로하지만 종소리와 휘파람이 있어야합니다. 이 기능이 세 번째 통합 문서 (또는 추가 기능 등)에있는 경우 작동하며 작성된 기본 시트를 삭제하고 시트 순서가 원본과 동일하도록 보장합니다.

Option Explicit 

Sub copyAll() 

Dim Output As Workbook, Source As Workbook 
Dim sh As Worksheet 
Dim FileName As String 
Dim firstCell 

Application.ScreenUpdating = False 
Set Source = ActiveWorkbook 

Set Output = Workbooks.Add 
Application.DisplayAlerts = False 

Dim i As Integer 

For Each sh In Source.Worksheets 

    Dim newSheet As Worksheet 

    ' select all used cells in the source sheet: 
    sh.Activate 
    sh.UsedRange.Select 
    Application.CutCopyMode = False 
    Selection.Copy 

    ' create new destination sheet: 
    Set newSheet = Output.Worksheets.Add(after:=Output.Worksheets(Output.Worksheets.Count)) 
    newSheet.Name = sh.Name 

    ' make sure the destination sheet is selected with the right cell: 
    newSheet.Activate 
    firstCell = sh.UsedRange.Cells(1, 1).Address 
    newSheet.Range(firstCell).Select 

    ' paste the values: 
    Range(firstCell).PasteSpecial Paste:=xlPasteValues, _ 
    Operation:=xlNone, SkipBlanks:=True, Transpose:=False 

Next 

' delete the sheets that were originally there 
While Output.Sheets.Count > Source.Worksheets.Count 
    Output.Sheets(1).Delete 
Wend 
FileName = ThisWorkbook.Path & "\" & "worksheet2.xlsx" 
Output.SaveAs FileName 
Output.Close 
Application.ScreenUpdating = True 

End Sub 

Answer 4

이것은 모든 서식, 열 너비, 만 값을 유지 할 수 있도록해야한다.

Option Explicit 

Sub copyAll() 

Dim Output As Workbook, Source As Workbook 
Dim sh As Worksheet 
Dim FileName As String 
Dim firstCell 

Application.ScreenUpdating = False 
Set Source = ActiveWorkbook 

Set Output = Workbooks.Add 
Application.DisplayAlerts = False 

Dim i As Integer 

For Each sh In Source.Worksheets 

    Dim newSheet As Worksheet 

    ' select all used cells in the source sheet: 
    sh.Activate 
    sh.UsedRange.Select 
    Application.CutCopyMode = False 
    Selection.Copy 

    ' create new destination sheet: 
    Set newSheet = Output.Worksheets.Add(after:=Output.Worksheets(Output.Worksheets.Count)) 
    newSheet.Name = sh.Name 

    ' make sure the destination sheet is selected with the right cell: 
    newSheet.Activate 
    firstCell = sh.UsedRange.Cells(1, 1).Address 
    newSheet.Range(firstCell).Select 

    ' paste the values: 
    Range(firstCell).PasteSpecial Paste:=xlPasteColumnWidths 
    Range(firstCell).PasteSpecial Paste:=xlPasteFormats 
    Range(firstCell).PasteSpecial Paste:=xlPasteValues, _ 
    Operation:=xlNone, SkipBlanks:=True, Transpose:=False 

Next 

' delete the sheets that were originally there 
While Output.Sheets.Count > Source.Worksheets.Count 
    Output.Sheets(1).Delete 
Wend 
FileName = ThisWorkbook.Path & "\" & "worksheet2.xlsx" 
Output.SaveAs FileName 
Output.Close 
Application.ScreenUpdating = True 

End Sub