Me again , I'm trying to code for spliting sheets in the xlsm file into the seperate sheet then save them in the same place with the xlsm file. the code as below:
Sub splitsheet()
Dim path As String
Dim cities
ReDim cities(1 To ThisWorkbook.Worksheets.Count)
Dim i As Long
Dim sh As Worksheet
path = ActiveWorkbook.path
For i = 1 To Worksheets.Count
cities(i) = Sheets(i).Name
ActiveWorkbook.SaveAs _
Filename:=path & "\" & Sheets(i).Name & ".xlsx"
'ActiveWorkbook.Close False
Next i
End Sub
The error in my photo below. Why it can not save as in "xlsx" extension , above code is work fine with "xlsm" extension
Filename:=path & "\" & Sheets(i).Name & ".xlsm" 'it can work fine with xlsm extension
My question is how can save as in "xlsx" extension in this case. All assist/explaination will be appriciated.
Please try this code.
Sub EachSheetToEachOwnWorkbook()
' 286
Dim Path As String
Dim Ws As Worksheet
Application.ScreenUpdating = False
Path = ThisWorkbook.Path & "\"
For Each Ws In ThisWorkbook.Worksheets
Ws.Copy
With ActiveWorkbook
.SaveAs Filename:=Path & Ws.Name & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
.Close
End With
Next Ws
Application.ScreenUpdating = True
End Sub
Related
I am trying to save a particular worksheet from my working workbook to another workbook, and trying to save it in the path of my current workbook. The saving option is in such a way that it should get saved with the dd.mm.yyyy.
I tried the following code and I am getting application defined error in the line
> newWB.SaveAs filename:=Path2 & Format(Now(), "yyyymmdd") &
> myWorksheets(i), FileFormat:=xlsx
Could you please help me figure out where I am wrong?
Sub save()
Dim myWorksheets() As String 'Array to hold worksheet names to copy
Dim newWB As Workbook
Dim CurrWB As Workbook
Dim i As Integer
Dim path1, Path2
path1 = ThisWorkbook.Path
Path2 = path1 & "\TT"
Set CurrWB = ThisWorkbook
myWorksheets = Split("Report", ",")
For i = LBound(myWorksheets) To UBound(myWorksheets) 'Go through entire array
Set newWB = Workbooks.Add 'Create new workbook
CurrWB.Sheets(Trim(myWorksheets(i))).Copy
newWB.SaveAs filename:=Path2 & Format(Now(), "yyyymmdd") & myWorksheets(i), FileFormat:=xlsx
newWB.Close saveChanges:=False
Next i
CurrWB.Save 'save original workbook.
End Sub
#Jenny - This code will accomplish what you ask in your question, it will save the ActiveSheet as a new file; and can be used as a function the can be called within your code. You can change the "Rpt" to identify the title of the new workbook. When I'm writing vba code, I always try to follow what my mother use to say to me, "Keep it simple".
Application.DisplayAlerts = False
Dim wbPath As String
wbPath = ThisWorkbook.Path
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=wbPath & "\" & "Rpt" & " " & Format(Date, "yyyymmdd") & ".xlsx", _
FileFormat:=51, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
I would like to convert all XLSX files in a certain directory to CSV files. Each resulting CSV file should only contain the first worksheet of the XLSX file and be saved in a subfolder of the directory.
I am using the following script which works fine, except that it saves all worksheets as a separate CSV. I just need the first.
Could someone tell me how to modify the script? I have very little experience with VBA.
Sub Loop_Through_Files()
Dim WS As Excel.Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Application.ScreenUpdating = False
Application.DisplayAlerts = False
myExtension = "*.xl??"
myPath = ActiveWorkbook.Path
myFile = Dir(myPath & "\" & "Input" & "\" & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Open workbook
Set x = Workbooks.Open(Filename:=myPath & "\" & "Input" & "\" & myFile)
SaveToDirectory = ActiveWorkbook.Path
For Each WS In x.Worksheets
WS.SaveAs SaveToDirectory & Left(x.Name, InStr(x.Name, ".") - 1) & "_" & WS.Name, xlCSV
Next
x.Close SaveChanges:=True
'Get next file name
myFile = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Replace your for loop with this:
WS = x.Sheets(1)
WS.SaveAs SaveToDirectory & Left(x.Name, InStr(x.Name, ".") - 1) & "_" & WS.Name, xlCSV
I know i should probably be doing this in access or VB but I dont know how to use either. At the moment I have a submit button at the end of my form that saves and closes the workbook as whatever is inputted to a certain cell.
I am looking for a way to be able to do the same thing but break the worksheet out of the workbook. So it saves just the worksheet as its own excel file and with the name inputted into a certain cell. Below is the macro I am currently using.
Sub Saveworkbook()
Application.DisplayAlerts = False
Dim dName$, vName$
dName = Range("B8")
vName = ActiveWorkbook.FullName
ActiveWorkbook.SaveAs "W:\Test\" & dName
ActiveWorkbook.SaveAs vName
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
It would also be cool if it could add the date and computers user in to save name but not essential.
Thanks in advance
Sam
Something like this -
Sub SaveSheet()
Dim wbkDashboard As Workbook
Dim wsTarget As Worksheet
Set wsTarget = Thisworkbook.worksheets("Sheet1")
Dim strFileName As String
strFileName = wsTarget.Range("B8").Value _
& Format(Now, "ddmmyyyy") & "-" & Environ("username") & ".xlsx"
Set wbkDashboard = Workbooks.Add
wsTarget .Copy Before:=wbkDashboard.Sheets(1)
For intSheetCount = 2 To wbkDashboard.Sheets.Count
wbkDashboard.Sheets(2).Delete
Next
wbkDashboard.SaveAs "W:\Test\" & wsTarget.Range("B8").Value _
& Format(Now, "ddmmyyyy") & "-" & Environ("username") & ".xlsx"
wbkDashboard.Close
wsTarget.Range("B8").Value= strFileName
Set wsTarget = Nothing
Set wbkDashboard = Nothing
End Sub
This code will save any changes you have created in the current version, then it will save just the Active Sheet as a new workbook with the username and date (Credit to #Will on the Environment Variables).
Sub Saveworkbook()
Application.DisplayAlerts = False
Dim Sheet1 As Worksheet
Dim dName$, vName$, sName$
dName = Range("B8")
vName = ActiveWorkbook.FullName
sName = ActiveWorkbook.ActiveSheet.Name
For Each Sheet1 In ActiveWorkbook.Sheets
If Not Sheet1.Name = sName Then
Sheet1.Delete
End If
Next Sheet1
ActiveWorkbook.SaveAs "W:\Test\" & dName & "_" & Environ("username") & "_" & Format(Now, "ddmmyy") & "xlsx"
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
I have a folder which has .csv files, .xls files, and xlsx files. The below code is a portion of an overall project (when I remove the below code, the remaining code achieves what I want). A large chunk of the code was compiled from somewhere (here and around the internet). What I want the code to do is open only the .csv files in the folder, convert them to an Excel file, close the files, and then delete the .csv files in the folder. What ends up happening with the code is that one or both of the files created by the code are deleted from the folder, and I am left with nothing. Thanks in advance for any help.
Sub Test()
'
' Test Macro
'
'Set variables for the below loop
Dim MyFolder As String
Dim MyFile As String
Dim GetBook As String
Dim GetBook2 As String
Dim MyCSVFile As String
Dim KillFile As String
MyFolder = "REDACTED"
MyFile = Dir(MyFolder & "\*.xls")
MyCSVFile = Dir(MyFolder & "\*.csv")
'Open all of the .csv files in the folder and convert to .xls
Do While MyCSVFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyCSVFile
GetBook = ActiveWorkbook.Name
GetBook2 = Left(GetBook, Len(GetBook) - 4)
ActiveSheet.Name = "Sheet1"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=GetBook2, FileFormat:=56
ActiveWorkbook.Close False
Kill MyFolder & "\" & GetBook
Loop
End Sub
You are not calling the Dir function to get the next file.
Sub Test()
'Set variables for the below loop
Dim myFolder As String
Dim getBook As String
Dim myCSVFile As String
Application.DisplayAlerts = False
myFolder = Environ("TEMP") & Chr(92) & "REDACTED"
myCSVFile = Dir(myFolder & "\*.csv")
Do While myCSVFile <> ""
Workbooks.Open Filename:=myFolder & "\" & myCSVFile
getBook = ActiveSheet.Name '<~ Sheet1 of an opened CSV is the name of the CSV
ActiveSheet.Name = "Sheet1"
ActiveWorkbook.SaveAs Filename:=myFolder & Chr(92) & getBook, FileFormat:=56
ActiveWorkbook.Close False
Kill myFolder & Chr(92) & myCSVFile '<~~ delete the CSV, not the workbook
myCSVFile = Dir '<~~ this is important to get the next file in the folder listing
Loop
End Sub
The only worksheet in an opened CSV is named for the CSV (without the .CSV extension) so that can be used in the Workbook.SaveAs method. I've used xlOpenXMLWorkbook as the SaveAs FileFormat type.
I have some code here that makes you save all the sheets in a workbook as CSVs. Can anyone help me figure out a way for this code to open only sheet 3 "Sheet3" and save it as a CSV?
Private Sub CommandButton22_Click() 'Save as CSV
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "H:\Test\"
For Each WS In ThisWorkbook.Worksheets
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Next
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
End Sub
as Raystafarian mentioned, here's the code
For Each WS In ThisWorkbook.Worksheets
If WS.name= "Sheet3" then
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
End If
Next
Replace
For Each WS In ThisWorkbook.Worksheets
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Next
with
ThisWorkbook.Sheets("sheet3").SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV