extract to another workbook and save using desktop path

[dudematters21]

hello good day masters!
my first post here, thank you for the help in advanced

i have recorded a macro to extract a sheet then paste it another workbook
my question is can we add a code werein i can save this using file name based on a cell value
lets say -- "K4" has a text saying ABCDE, so I want to save it using that name.. ofcourse this value constantly changes

so far this is the code that came up..
i hope there's a solution..

Sub Xtract ()

Sheets ("Sheet1").Select
Range("B1:C3").Select
Selection.Copy
Range ("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet2").Select
Application.CutCopyMode = False
Sheets("Sheet2").Copy
Range("E1:F1").Select
Selection.Copy
Application.CutCopyMode = False
ActiveWorkBook.SavaAs Filename:="H:\FFFF.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup=False
Windows("MAIN.xlsb.xlsm").Activate
Range("A6").Select
End Sub

 

[jolivanes]

Forget about your macro for now.
Explain in detail what you want to achieve.
i.e. you mention "extract a sheet" but you copy/paste a range, you request to save to desktop but your code mentions "H:\FFFF.xlsx"

It is easy enough to:
1. Create a workbook from a sheet and save to desktop
or
2. create a workbook from a range of data and save as a new workbook to the desktop

If it is a range, need to know the sheet name and range address

 

[jolivanes]

This will save Sheet2 as it's own non macro workbook on the desktop.
It will be named as the value of range K4 on sheet2

Sub Sheet2_Only()
Sheets("Sheet2").Copy
With ActiveWorkbook
    .SaveAs CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Cells(4, 11).Value & ".xlsx", 51
    .Close
End With
End Sub

 

[jolivanes]

Sub A_Range_Only()
Dim wb1 As Workbook, nm As String
Set wb1 = ThisWorkbook
nm = wb1.Sheets("Sheet2").Range("K4").Value
    With Workbooks.Add
        wb1.Sheets("Sheet2").Range("A1:K37").Copy ActiveWorkbook.Sheets("Sheet1").Range("A1")
        .SaveAs CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & nm & ".xlsx", 51
        .Close
    End With
End Sub

For both suggestions, Post #3 and this Post, check references and change if and where required.

 

[dudematters21]

Sub A_Range_Only()
Dim wb1 As Workbook, nm As String
Set wb1 = ThisWorkbook
nm = wb1.Sheets("Sheet2").Range("K4").Value
    With Workbooks.Add
        wb1.Sheets("Sheet2").Range("A1:K37").Copy ActiveWorkbook.Sheets("Sheet1").Range("A1")
        .SaveAs CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & nm & ".xlsx", 51
        .Close
    End With
End Sub

For both suggestions, Post #3 and this Post, check references and change if and where required.

nice this works amazing.. just notice though that the columns did not align properly.. os there a way we automatically adjust the columns?

 

[jolivanes]

Re: "columns did not align properly"
Don't know what the means. All the macro does is copy and paste some data from one sheet into another sheet.
Or do you mean the column width?

 

[dudematters21]

Re: "columns did not align properly"
Don't know what the means. All the macro does is copy and paste some data from one sheet into another sheet.
Or do you mean the column width?

 

[dudematters21]

yup the width i mean, tried to place .autofit but i cant seem to figure where to place it exactly.. tia!

 

[jolivanes]

Insert the one line as shown below (the middle line of the three lines). Change references as required.

        wb1.Sheets("Sheet2").Range("A1:K37").Copy ActiveWorkbook.Sheets("Sheet1").Range("A1")
            .Sheets("Sheet1").Columns("A:K").AutoFit    '<---- Change Sheet Name and Column reference as required
        .SaveAs CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & nm & ".xlsx", 51

 

[dudematters21]

hey the autofit works, however encountered some trouble, it seems that it copies the formula itself instead of the values..so when it generates in sheet1 it returns as "0" or #REF

** column b2:b11 relies on column d2:d11
** so cell b2 has a formula of =d2 but yeah on the extracted worksheet it shows "0" since it copied the formula instead


Sub XTRACT ()

Dim wb1 As Workbook, nm As String
Set wb1 = ThisWorkBook
nm = wb1.sheets("Farm").Range("B16").Value

With Workbooks.Add
wb1.Sheets("Farm").Range("A1:B11").Copy Activeworkbook.sheets("Sheet1").Range("A1")
.Sheets("Sheet1").Columns("A:B").autofit
.SaveAs CreateObject ("Wscript.Shell") .SpecialFolders ("Desktop") & "\" & nm ".xlsx", 51
.Close
End With
End Sub