I have a question, I would like to save all my worksheets to seperate csv files and after it is finished the original excel file should be used. I've found some questions related to this on stackoverflow BUT I cannot combine them to make it work :(
Here is what I have at the moment which works:
Sub SaveSheetsAsCsv()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
ws.SaveAs ActiveWorkbook.Path & "\" & ws.Name & ".csv", xlCSV, Local:=True
Next
Application.DisplayAlerts = True
End Sub
The result, I have all my worksheets saved to the same folder BUT then my workbook is named as my last worksheet and if I want to close it says I have to save it ... but instead I would like to have my original excel file active.
Any idea how can I do that?
I've tried to implement this: Keep the same excel but I always get an error :(
Any advice and help would be appreciated.
The adjustment below copies the sheet to a new book, saves it as CSV and closes.
Sub SaveSheetsAsCsv()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
ws.Copy
ActiveWorkbook.SaveAs wb.Path & "\" & ws.Name & ".csv", xlCSV, Local:=True
ActiveWorkbook.Close
Next
Application.DisplayAlerts = True
End Sub
Related
I have a macro in a workbook that saves selected sheets in a workbook as separate csv files. I thought this was working fine but I now seem to be getting the error message below, I'm not sure if I've inadvertently changed something, as I was trying to write a separate macro to run this one from another workbook.
Error message:
Run time error '1004'
Cannot access read-only document ' Activity.csv'
Public Sub SaveWorksheetsAsCsv3()
'save workbook before continuing
ActiveWorkbook.Save
Application.DisplayAlerts = False
'save each sheet as csv
Dim WB As Workbook
Dim WS As Worksheet
Dim FolderPath As String
Dim FileName As String
'folder path for saving
FolderPath = Range("B3").Value
'loop through all sheets
For Each WS In Worksheets
'ignore these sheets
If WS.Name <> "Control" And WS.Name <> "Summary" Then
'copy current sheet
WS.Copy
Set WB = ActiveWorkbook
'save as csv file
FileName = WS.Name
WB.SaveAs FileName:=FolderPath & "\" & FileName, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
WB.Close
Application.DisplayAlerts = False
End If
Next WS
End Sub
I have an Excel file with 4 auxaliary sheets + 7 sheets with tables.
I would like to copy and separate each sheet (of the 7 sheets) into multiple excel's, so that each excel file has only 1 table. These sheets starts with "Lista", as for example "Lista_AA", "Lista_BB"...
After I would like to save these sheets with same name they had in the main excel.
I don't have code because I try with with macro recorder and didn't function.I have already looked for several videos and questions on this site and they are a little different from what I want
I have this code for create these sheets in pdf:
Sub excels()
Application.ScreenUpdating = False
Dim i As Integer
Dim nome_arquivo As String
For i = 5 To Sheets.Count
nome_arquivo = Sheets(i).Name
With Sheets(i)
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & nome_arquivo & ".pdf"
End With
Next i
Application.ScreenUpdating = True
End Sub
Is it possible to adapt for Excel files for same sheets?
Use a loop:
Const filepath As String = "https://agits-my.sharepoint.com/personal/Documents/Desktop/Cantina/"
Sub macro()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "Lista_*" Then
SaveCopy ws:=ws
End If
Next
End Sub
Private Sub SaveCopy(ByVal ws As Worksheet)
ws.Copy
Dim wb As Workbook
Set wb = ActiveWorkbook
wb.SaveAs FileName:=filepath & ws.Name & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
wb.Close SaveChanges:=False
End Sub
How do I save a specific sheet to a new workbook using Excel VBA?
I have multiple sheets with names "Sheet1", "Sheet2", "Sheet3" and so on.
I'd like to save all, in individual workbooks, with a single click.
This is returns an alert
Method Save as of object workbook failed
Sub SaveSplitSheet()
Dim ws As Worksheet
Dim wb As Workbook
For Each ws In ThisWorkbook.Sheets
If ws.Name Like "Sheet" & "*" Then
Application.DisplayAlerts = False
ws.Copy
ActiveWorkbook.SaveAs "/Users/Tukiyem/Downloads", FileFormat:=56
ActiveWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True
End If
Next
End Sub
Found the answer-> the code below saves multiple sheets that contain name "sheet...." as individual workbooks.
Sub SaveAsInLoop()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If ws.Name Like "Sheet" & "*" Then
Application.DisplayAlerts = False
ws.Copy
ActiveWorkbook.SaveAs "/Users/Tukiyem/Downloads/" & ws.Name & ".xlsx", FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True
End If
Next
End Sub
I would slightly tweak your code to a For...Next loop rather For Each...Next which will allow the evaluation of which number sheet we are up to in the loop.
This code is an example of how to loop through the worksheets. It will print each sheet name to the Immediate window of the VBE.
Just adapt your SaveAs code within the loop.
Sub SaveAsInLoop()
Dim SheetNumber As Long
For SheetNumber = 1 To ThisWorkbook.Sheets.Count
Debug.Print Sheets("Sheet" & SheetNumber).Name
Next SheetNumber
End Sub
The vba is to copy a range --> create a new workbook --> save it as csv, I managed to reach the below, but it opens too many workbooks, and it keeps them opened even after saving them as csv
I've tried the close thing, but its still not working, what can I do to stop this :(
Columns("A:F").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Dim wbNew As Workbook
Dim strFileName As String
With ActiveSheet
strFileName = .Range("A2").Value
.Copy
End With
Set wbNew = ActiveWorkbook
wbNew.SaveAs ThisWorkbook.Path & "\" & strFileName, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = False
ActiveWorkbook.Close
Workbooks("Paul_Automation_Project_Ver2.xlsm").Activate
Next
End Sub
I'm trying to do the following:
Export/Copy particular sheets in the workbook (any sheet name that contains "Upload") to a particular file directory.
I don't want these worksheet names to change nor the workbook name to change.
The file-name is consistent for each worksheet, so it would be okay to replace the files in the directory whenever I run the macro. It is okay to have a dialog box that asks if I'm sure I want to replace each of the files.
I don't want the newly created CSVs or any other file to open.
Sub SheetsToCSV()
'Jerry Beaucaire (1/25/2010), updated (8/15/2015)
'Save each sheet to an individual CSV file
Dim ws As Worksheet, fPATH As String
Application.ScreenUpdating = False 'speed up macro
Application.DisplayAlerts = False 'automatically overwrite old files
fPATH = "C:\2015\CSV\" 'path to save into, remember the final \ in this string
For Each ws In Worksheets
ws.Copy
ActiveWorkbook.SaveAs Filename:=fPATH & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Next ws
Application.ScreenUpdating = True
End Sub
You just need to add a simple loop through all worksheets and test the name.
Try this:-
Sub COPYSelectedSheetsToCSV()
Dim ws As Worksheet
'In case something goes wrong
On Error GoTo COPYSelectedSheetsToCSVZ
'Loop through all worksheets
For Each ws In ActiveWorkbook.Sheets
'Does the name contain "Upload"
If InStr(1, ws.Name, "Upload") > 0 Then
'Make the worksheet active
ws.Select
'Save it to CSV
ActiveWorkbook.SaveAs Filename:="/Users/reginaho/Desktop/Upload/" & ws.Name & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
End If
Next
COPYSelectedSheetsToCSVX:
'Clean up the memory usage
Set ws = Nothing
Exit Sub
COPYSelectedSheetsToCSVZ:
MsgBox Err.Number & " - " & Err.Description
Resume COPYSelectedSheetsToCSVX
End Sub