Range of selected cells copy & paste with all formats except formula; Save in a specific Folder; Name as a Cell Value

[nbuddhi]

Hi All,

I have a work book with different sheets. I want to select some cells of the active sheet then copy those data into a new excel file with font type, color of the fonts & column width formats except formula, finally new excel file would save in the folder "C:\Users\XXX\ABC" giving file name as the text in cell D5 of the source sheet. Kindly help me to have a macro to execute said function. Your support on this query is greatly Appreciated.

Thanks & Best Rgds,
Nuwan Buddhika

 

[AlanSidman]

Attach a sample workbook (not a picture or pasted copy). Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

 

[nbuddhi]

Attach a sample workbook (not a picture or pasted copy). Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Hi Alan,
Many thanks for your quick response. Herewith enclosed the source file and destination file for your better understanding.

 

[Chihiro]

Did you mean Cell D4 value as file name? (i.e. 12345).

At any rate. Something like below. Change fPath and the worksheet reference as required.

Sub Demo()
Dim wb As Workbook
Dim fName As String
Dim fPath As String: fPath = "C:\Test\" '"C:\Users\XXX\ABC\"
Dim obj

OptimizeVBA True
Set wb = Workbooks.Add
With ThisWorkbook.Sheets("Test Report")
    fName = .Range("D4").Text
    .Copy , wb.Sheets(1)
End With

With wb
    .Sheets("Sheet1").Delete
    .SaveAs fPath & fName & ".xlsx", 51
    With .Sheets("Test Report")
        .Range("J:M").Delete
        .Range("A:I").Copy
        .Range("A1").PasteSpecial xlValues
        For Each obj In .Shapes
            obj.Delete
        Next
    End With
    .Close True
End With
OptimizeVBA False
End Sub
Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.DisplayAlerts = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
End Sub

Workbook is saved twice. First save is to save as xlsx file. To remove worksheet codes in the copied sheet.

 

[nbuddhi]

Thank you Chihiro for your great support,
Yes exactly I need to use D5 cell data as the new file name. I tried as you advised changing path & sheet number; but neither error display nor file saved as desired. If I'm not bothering to you, could you please try to add the macro into attached file and send me back after testing? I'll change the path once gettting it. Thanks again

 

[Chihiro]

Yes exactly I need to use D5 cell data as the new file name.

Are you sure? In "Test Report" sheet, you have "Date Out" as value in D5. I assumed it's D4, as it's report no '12345' that's in the cell.

So you'd place the code in any of standard modules that you have. I placed it in Module9.

I made small adjustment to the code to have 2 string variable which you set at top of code.
These must be changed to reflect your actual environment/set up.
fPath & sName.

Then assign the sub (Sub Demo) to some button or assign short cut key combo and run it.

 

[nbuddhi]

Are you sure? In "Test Report" sheet, you have "Date Out" as value in D5. I assumed it's D4, as it's report no '12345' that's in the cell.

So you'd place the code in any of standard modules that you have. I placed it in Module9.

I made small adjustment to the code to have 2 string variable which you set at top of code.
These must be changed to reflect your actual environment/set up.
fPath & sName.

Then assign the sub (Sub Demo) to some button or assign short cut key combo and run it.

Solution Verified.
Wow, It worked as a charm. Sorry I made a mistake stating that reference cell value is D5, you are absolutely right and it is D4. Greatly appreciated your kind support. Cheers.