Copy selected range in current active worksheet to new workbook

Viewed 54

I want to copy a selected range to a new workbook without the formulas.

I have buttons on the sheet that run macros and they are also copied. The buttons are placed outside of the defined range, but from what I can see the code selects the whole sheet.

I only need the range that is defined with the formating but no formulas to be copied to a new workbook

Sub CopyToAnotherBook()
        
    ActiveSheet.Copy
    
    Cells.Copy 
    
    Range("B1:J58").PasteSpecial Paste:=xlPasteValues
    
    Application.CutCopyMode = False
    
End Sub
2 Answers

try this:

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

Copy Active (Work)Sheet To New Workbook

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
    
    ' Clean up.
    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
Related