Excel 将当前活动工作表复制到新工作簿 VBA 代码

Question

我想将 excel 中的选定范围复制到新工作簿，但我需要在没有公式的情况下复制，我遇到的问题是我在工作表上有运行宏的按钮，它们也被复制了，按钮被放置在定义的范围之外，但据我所知，由于某种原因，代码选择了整个工作表，而不仅仅是定义的范围，我只需要使用格式定义的范围，但不需要将公式复制到新工作簿

这是我运行的代码。

Sub CopyToAnotherBook()
    
ActiveSheet.Copy
   
 Cells.Copy 

 Range("B1:J58").PasteSpecial Paste:=xlPasteValues
   
Application.CutCopyMode = False

End Sub

Answer 1

尝试这个：

Sub doCopyRangeValuesToNewWorkbook()

    Dim wb As Workbook, targetWB As Workbook
    Dim ws As Worksheet, targetWS As Worksheet
    
    Set wb = ThisWorkbook 'source workbook
    Set ws = wb.ActiveSheet 'source work sheet
    
    Set targetWB = Workbooks.Add 'target workbook
    Set targetWS = targetWB.Sheets.Add 'target worksheet
    
    targetWS.[B1:J58].Value = ws.[B1:J58].Value

    'or as in your example, you can use Copy method
    'ws.[B1:J58].Copy: targetWS.[B1:J58].PasteSpecial Paste:=xlPasteValues
    
End Sub

Answer 2

将活动（工作）表复制到新工作簿

Sub ExportActiveSheet()
    
    ' Define constants.
    Const sfCellAddress As String = "A1"
    Const dfCellAddress As String = "A1"

    ' Validate the active sheet.
    
    If ActiveSheet Is Nothing Then
        MsgBox "No visible workbooks open.", vbExclamation
        Exit Sub
    End If
        
    If Not TypeOf ActiveSheet Is Worksheet Then
        MsgBox "The active sheet is not a worksheet.", vbExclamation
        Exit Sub
    End If
    
    ' Reference the source range.
    
    Dim sws As Worksheet: Set sws = ActiveSheet
    
    Dim srg As Range
    
    With sws.UsedRange
        ' from the given cell to the last cell of the used range
        Set srg = sws.Range(sfCellAddress, .Cells(.Rows.Count, .Columns.Count))
    End With
    ' For a range, use this instead of the previous With statement.
    'Set srg = sws.Range("B1:J58")
    
    ' Reference the destination range.
    
    Dim dwb As Workbook: Set dwb = Workbooks.Add(xlWBATWorksheet)
    
    Dim dws As Worksheet: Set dws = dwb.Worksheets(1)
    dws.Name = sws.Name
    
    Dim drg As Range
    ' the same size as the source range, but from the given cell
     Set drg = dws.Range(dfCellAddress) _
        .Resize(srg.Rows.Count, srg.Columns.Count)
    ' the same size and position as the source range
    'Set drg = dws.Range(srg.Address)
    
    ' Copy.
    
    Application.ScreenUpdating = False
    
    srg.Copy
    drg.PasteSpecial xlPasteColumnWidths
    drg.PasteSpecial xlPasteFormats
    drg.Value = srg.Value ' copy values
    
    ' Initialize.
    With Application
        .CutCopyMode = False
        If Not dwb Is ActiveWorkbook Then dwb.Activate
        .Goto Reference:=drg.Range("A1"), Scroll:=True ' first cell
        dwb.Saved = True ' while testing, to close manually without confirmation
        .ScreenUpdating = True
    End With
    
    ' Inform.
    MsgBox "Worksheet exported.", vbInformation

End Sub