最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

Excel VBA - Save range as values into another workbook - Stack Overflow

programmeradmin0浏览0评论

The following code works to save the whole sheet as values into another workbook, but I want just a range in that sheet. Whatever I try, deletes the VLOOKUP code etc. in the master sheet, unless I save the whole sheet.

Sub toolgo()

'exports desired sheet to new XLSX file


Dim MyPath As String

Dim MyFileName As String

Range("D3").Select

MyFileName = Sheet1.Range("D3").Value

If Not Right(MyFileName, 4) = ".xlsx" Then MyFileName = MyFileName & ".xlsx"

Sheets("Sheet1").Copy 'I want a range B3:H77 not whole sheet


With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Where should we save this?"
.AllowMultiSelect = False
.InitialFileName = "C:\Users\fred\" '<~~ The start folder path for the file      picker.
If .Show <> -1 Then GoTo NextCode
MyPath = .SelectedItems(1) & "\"

End With

NextCode:

With ActiveWorkbook
    .ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value '<~~ converts        contents of XLSX file to values only
    .SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlOpenXMLWorkbook,  CreateBackup:=False
    .Close False
End With

End Sub

What in the above needs changing to get the range exported into another workbook? Thank you

I tried: -

Range("B4:H76").Copy
Sheets("Sheet1").Range("B4:H76").Copy
Range("B4:H76").Select
Selection.Copy

The following code works to save the whole sheet as values into another workbook, but I want just a range in that sheet. Whatever I try, deletes the VLOOKUP code etc. in the master sheet, unless I save the whole sheet.

Sub toolgo()

'exports desired sheet to new XLSX file


Dim MyPath As String

Dim MyFileName As String

Range("D3").Select

MyFileName = Sheet1.Range("D3").Value

If Not Right(MyFileName, 4) = ".xlsx" Then MyFileName = MyFileName & ".xlsx"

Sheets("Sheet1").Copy 'I want a range B3:H77 not whole sheet


With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Where should we save this?"
.AllowMultiSelect = False
.InitialFileName = "C:\Users\fred\" '<~~ The start folder path for the file      picker.
If .Show <> -1 Then GoTo NextCode
MyPath = .SelectedItems(1) & "\"

End With

NextCode:

With ActiveWorkbook
    .ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value '<~~ converts        contents of XLSX file to values only
    .SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlOpenXMLWorkbook,  CreateBackup:=False
    .Close False
End With

End Sub

What in the above needs changing to get the range exported into another workbook? Thank you

I tried: -

Range("B4:H76").Copy
Sheets("Sheet1").Range("B4:H76").Copy
Range("B4:H76").Select
Selection.Copy
Share Improve this question asked Feb 5 at 20:51 VBA-JuniorVBA-Junior 112 bronze badges 2
  • Should the copied range end up in the same place on the new sheet? – Tim Williams Commented Feb 5 at 20:52
  • 2 The Sheets("Sheet1").Copy line creates a new workbook with a copy of "Sheet1". You can create a new blank workbook with Workbooks.Add and copy the data across into that… or, you can delete the data you don't want after you convert the contents to values-only… – Chronocidal Commented Feb 5 at 21:11
Add a comment  | 

1 Answer 1

Reset to default 0

Copy Values to a New File

Sub CreateBackup()

    ' Define constants.        
    Const SRC_SHEET_NAME As String = "Sheet1"
    Const SRC_RANGE_ADDRESS As String = "B3:H77"
    Const SRC_DST_FILE_NAME_CELL_ADDRESS As String = "D3"
    Const DST_INI_FOLDER_PATH As String = "C:\Users\Fred\"
    Const DST_FIRST_CELL_ADDRESS As String = "A1"

    ' Let the user choose the destination folder.
    Dim dFolderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Where should we save this?"
        '.AllowMultiSelect = False ' doesn't work, you can only select one
        .InitialFileName = DST_INI_FOLDER_PATH
        If .Show <> -1 Then Exit Sub ' cancelled
        dFolderPath = .SelectedItems(1) & "\"
    End With
    
    ' Reference the source objects.
    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = swb.Sheets(SRC_SHEET_NAME)
    Dim srg As Range: Set srg = sws.Range(SRC_RANGE_ADDRESS)
    ' Be consistent, i.e., either use the above using the tab name
    ' or use the code name 'Set srg = Sheet1.Range(SRC_RANGE_ADDRESS)'.
    ' The latter allows for renaming the sheet (modifying its tab name).
    
    ' Retrieve the destination file name.
    Dim dFileName As String:
    dFileName = sws.Range(SRC_DST_FILE_NAME_CELL_ADDRESS).Value
    If Not Right(dFileName, 4) = ".xlsx" Then dFileName = dFileName & ".xlsx"
    
    ' Reference the destination objects.
    Dim dwb As Workbook: Set dwb = Workbooks.Add(xlWBATWorksheet) ' one only
    Dim dws As Worksheet: Set dws = dwb.Sheets(1)
    'dws.Name = sws.Name ' rename the sheet?
    Dim drg As Range: Set drg = dws.Range(DST_FIRST_CELL_ADDRESS) _
        .Resize(srg.Rows.Count, srg.Columns.Count)
        
    ' Copy values.
    drg.Value = srg.Value
    
    ' Save the destination workbook.
    Application.DisplayAlerts = False ' overwrite without confirmation
        dwb.SaveAs _
            Filename:=dFolderPath & dFileName, _
            FileFormat:=xlOpenXMLWorkbook, _
            CreateBackup:=False
    Application.DisplayAlerts = True
    dwb.Close SaveChanges:=False ' just got saved
 
    ' Inform.
    MsgBox "Backup created.", vbInformation
 
End Sub
发布评论

评论列表(0)

  1. 暂无评论