导出到新工作簿

Export to new workbook

当我使用此代码时,我得到另存为 window 并按我的意愿保存工作簿,但我还从原始的 sheet 中获得了另一个工作簿,需要帮助才能获得一个和保存后是否可以关闭

代码

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 实际上是使用该工作表创建新工作簿的代码。