extract to another workbook and save using desktop path

dudematters21

New Member
Joined
Oct 12, 2024
Messages
10
Office Version
  1. 365
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
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
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
 
Upvote 0
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
Code:
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
 
Upvote 0
Code:
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.
 
Upvote 1
Code:
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?
 
Upvote 0
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?
 
Upvote 0
yup the width i mean, tried to place .autofit but i cant seem to figure where to place it exactly.. tia!
 
Upvote 0
Insert the one line as shown below (the middle line of the three lines). Change references as required.
Code:
        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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,224,567
Messages
6,179,564
Members
452,926
Latest member
rows and columns

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top