导出到新工作簿

如何解决导出到新工作簿

当我使用此代码时，我会保存为窗口并按自己的意愿保存工作簿，但是我还会从原始工作簿中再获得一个包含活动工作表的工作簿，只需要得到一个帮助即可，如果保存后可以将其关闭。

代码

Sub WorksheetSaveToNewWorkbook()
    Dim loc As Variant
    Dim Rng     As Range
    Dim newName As String
    Dim newWkb  As Workbook
    Dim newWks  As Worksheet
    Dim Wks     As Worksheet
    Dim Shp     As Shape
    
    Application.DisplayAlerts = False
    
    Set Wks = ThisWorkbook.ActiveSheet
        Set Rng = Wks.Range("Q3:S170")
        
        Data = Range("Q3:S170")
        
        Wks.Copy
        Set newWkb = Workbooks.Add
        Set newWks = newWkb.ActiveSheet
        
        With newWks
            .Range("A1").Resize(UBound(Data,1),UBound(Data,2)).Value = Data
            newName = " inklinometrija" & ".xlsx"
            
            For Each Shp In .Shapes
                Shp.OnAction = ""
            Next Shp
            
    loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx),*.xlsx",Title:="Save As...",InitialFileName:=newName)
    If loc <> False Then
        ActiveWorkbook.SaveAs Filename:=loc,FileFormat:=xlOpenXMLWorkbook
        Application.DisplayAlerts = True
        Exit Sub
    End If
    Application.DisplayAlerts = True
    
    End With
    
End Sub

解决方法

Wks.Copy
Set newWkb = Workbooks.Add
Set newWks = newWkb.ActiveSheet

Wks.copy实际上是使用该工作表创建新工作簿的代码。