Home > Net >  Excel copy current active worksheet to new workbook VBA Code
Excel copy current active worksheet to new workbook VBA Code

Time:09-19

I want to copy a selected range in excel to a new workbook but I need to copy with out the formulas, the problem I am having is that I have Buttons on the sheet that run Macros and they are also copied over,The buttons are placed outside of the defined range, but from what I can see is that for some reason the code selects the whole sheet and not just the defined ranges I only need the range that is defined with the formating but no formulas to be copied to a new workbook

Here is the code I run.

Sub CopyToAnotherBook()
    
ActiveSheet.Copy
   
 Cells.Copy 

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

End Sub

CodePudding user response:

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

CodePudding user response:

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
    
    ' 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
  • Related