Exporting Single Sheet to Network Path

jamesmev

Board Regular
Joined
Apr 9, 2015
Messages
233
Office Version
  1. 365
Platform
  1. Windows
I am currently working on a workbook that all I need exported into a network path is the first worksheet.
I am able to get this to save and move. However, it is saving on the main file. It is not saving within the folder I need it saved at.

Below is the code I am using...
**
Sub Mail_ActiveSheetDT()


Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object




With Application
.ScreenUpdating = False
.EnableEvents = False
End With


Set Sourcewb = ActiveWorkbook


'Copy the ActiveSheet to a new workbook
Sheets("Combined").Copy
Set Destwb = ActiveWorkbook


'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With


'Change all cells in the worksheet to values if you want
With Destwb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False


'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & ""
TempFileName = "Downtime Form" & " " & Format(Now, "dd-mmm-yy")


Dim SaveName As String
SaveName = ActiveSheet.Range("A1").Text
ActiveWorkbook.SaveAs Filename:="C:\Users\xxxx\Desktop\TEST" & _
SaveName & ".xls"
End Sub ***
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Code:
Sub Create_single_file()
Dim rs As Worksheet
Set rs = Worksheets("Sheet1") 'adjust name as needed
myPath = "\\nas\documents\" ' adjust path as needed
myFile = myPath & "File.xlsx"

rs.Cells.Copy

Set NewBook = Workbooks.add
NewBook.Worksheets("Sheet1").Range("A1").Select ' Special (xlPasteValues)(xlPasteformat)
ActiveSheet.Paste

NewBook.SaveAs FileName:=myFile
ActiveWorkbook.Close
End Sub

hth,

Ross
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,202
Members
448,554
Latest member
Gleisner2

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