I want to create a new (separate) workbooks for each worksheets from Test_Main but I am getting a
1004 error
in this line of code stating that I need a new name and cannot use this name as it is in use.
wb.SaveAs "H:\IT\Melissa\Essengeld\TEST" & "\" & ActiveSheet.Name & ".csv"
Is my code right? Or is there any other alternative for this ?
Thanks in advance !
Private Sub CommandButton3_Click()
Dim a As Integer
Dim ws As Worksheet
Dim wb As Workbook
a = ThisWorkbook.Worksheets.Count 'counts all the sheets
For i = 1 To a 'loops for all sheets
If ThisWorkbook.Worksheets(i).Name <> "Test_Main" Then 'rule out the main sheet
Set wb = Workbooks.Add
ThisWorkbook.Worksheets(i).Copy before:=wb.Worksheets(1) 'new workbook has 1 worksheet by deafult
wb.SaveAs "H:\IT\Melissa\Essengeld\TEST" & "\" & ActiveSheet.Name & ".csv"
wb.Close savechages = True
End If
Next i
ThisWorkbook.Activate
ThisWorkbook.Sheets(1).Activate
ThisWorkbook.Sheets(1).Cells(1, 1).Select
MsgBox ("Task Completed")
End Sub
Related
I have an Excel with several sheets I want to export to csv delimited by columns.
When I run the code, it exports the files to csv but comma delimited, not column delimited as I export in csv.
Any help would be appreciated.
Sub SaveShtsAsBook()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' End With
On Error Resume Next '<< a folder exists
MkDir (MyFilePath & "_csv") '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With
'save book in this folder
.SaveAs ThisWorkbook.path & "\_csv\" & SheetName & ".csv", FileFormat:=xlCSV
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub
Thanks!
Edit: Screenshot that clarifies my problem.
https://imgur.com/a/mPn997B
Define FileFormat as xlText and the file will be TAB delimited, which you obviously are looking for.
f.ex.:
Private Sub CommandButton1_Click()
Dim wb As Workbook
Set wb = ActiveWorkbook
wb.SaveAs "c:\tmp\tabtest.csv", xlText
End Sub
The code below creates and saves all the excel sheets from "Test_Main" into separate new workbooks with file extension .xlsx and I want it to save the workbook in .csv format. Could someone please alter my current code to do the required job ? Thanks in advance :)
Sub Workbook()
Dim a As Integer
Dim ws As Worksheet
Dim wb As Workbook
a = ThisWorkbook.Worksheets.Count 'counts all the sheets
For i = 1 To a 'loops for all sheets
If ThisWorkbook.Worksheets(i).Name <> "Test_Main" Then 'rule out the main sheet
Set wb = Workbooks.Add
ThisWorkbook.Worksheets(i).Copy before:=wb.Worksheets(1) 'new workbook has 1 worksheet by deafult
wb.SaveAs "H:\IT\Melissa\Essengeld\TEST\" & ThisWorkbook.Worksheets(i).Name
wb.Close savechages = True
End If
Next i
ThisWorkbook.Activate
ThisWorkbook.Sheets(1).Activate
ThisWorkbook.Sheets(1).Cells(1, 1).Select
MsgBox ("Task Completed")
End Sub
Microsoft answer question here -> https://learn.microsoft.com/en-us/office/vba/api/excel.workbook.saveas
I took code from to export a sheet from here
Sub exportSheet(sh As Worksheet, csvFilename As String)
Dim wbNew As Workbook
Set wbNew = Workbooks.Add
Dim wsNew As Worksheet
With wbNew
sh.Copy wbNew.Sheets(1)
Set wsNew = wbNew.Sheets(1)
.SaveAs Filename:=csvFilename, _
FileFormat:=xlCSVMSDOS, CreateBackup:=False
.Close False
End With
End Sub
and used it in your code like that
Sub exportToCSV()
Dim a As Integer
Dim ws As Worksheet
Dim wb As Workbook
a = ThisWorkbook.Worksheets.Count 'counts all the sheets
For i = 1 To a 'loops for all sheets
If ThisWorkbook.Worksheets(i).Name <> "Test_Main" Then 'rule out the main sheet
' Set wb = Workbooks.Add
' ThisWorkbook.Worksheets(i).Copy before:=wb.Worksheets(1) 'new workbook has 1 worksheet by deafult
' wb.SaveAs "H:\IT\Melissa\Essengeld\TEST\" & ThisWorkbook.Worksheets(i).Name
'
' wb.Close savechages = True
exportSheet ThisWorkbook.Worksheets(i), "H:\IT\Melissa\Essengeld\TEST\" & ThisWorkbook.Worksheets(i).Name
End If
Next i
ThisWorkbook.Activate
ThisWorkbook.Sheets(1).Activate
ThisWorkbook.Sheets(1).Cells(1, 1).Select
MsgBox ("Task Completed")
End Sub
I found the solution:
wb.SaveAs "H:\IT\Melissa\Essengeld\TEST" & ThisWorkbook.Worksheets(i).Name , FileFormat:=xlCSV
I'm trying to copy a worksheet data and save it in a new worksheet without copying the underlying formulas from the original sheet(shtAnalysis). I'm unable to do that as I'm getting error:
Paste Special Method of Range class failed
at the line
wsPaste.UsedRange.PasteSpecial xlPasteValues.
Public Sub PrepareFileAttachment()
Application.CalculateFull
Dim wrkBook As Workbook, wsPaste As Worksheet
Dim Path As String
Set wrkBook = Workbooks.Add
Set wsPaste = wrkBook.Worksheets(1)
Path = "C:\RandomPath" & "\" & "Report" & Format(Now, "mmddyyyy")
shtAnalysis.Copy
wsPaste.Activate
wsPaste.UsedRange.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ActiveWorkbook.SaveAs filename:=Path, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
shtControl.Range(GENERATED_FILENAME).Value = Path & ".xlsx"
ActiveWindow.Close
End Sub
Avoid the Activate and the Used.Range, thus, change these lines:
shtAnalysis.Copy
wsPaste.Activate
wsPaste.UsedRange.PasteSpecial xlPasteValues
To these:
shtAnalysis.Copy
wsPaste.PasteSpecial xlPasteValues
The original code is trying to copy the whole worksheet shtAnalysis, but is allowed to paste it only in the UsedRange, which is something that VBA does not like.
Please give this a try
Public Sub PrepareFileAttachment()
Application.CalculateFull
Dim wrkBook As Workbook, wsPaste As Worksheet
Dim openedWorkbook As Workbook
Dim Path As String
Set openedWorkbook = ThisWorkbook
Set wrkBook = Workbooks.Add
Set wsPaste = wrkBook.Worksheets(1)
Path = "C:\RandomPath" & "\" & "Report" & Format(Now, "mmddyyyy")
openedWorkbook.Sheets("shtAnalysis").Copy
wsPaste.Activate
wsPaste.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ActiveWorkbook.SaveAs Filename:=Path, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
shtControl.Range(GENERATED_FILENAME).Value = Path & ".xlsx"
ActiveWindow.Close
End Sub
I have workbook and there many sheets i want to copy one by one sheets to new work book and rename workbook
I tried, but it saved in one workbook instead of separate workbooks also I don't want to copy first worksheet to copy new workbook
Option Explicit
Sub CreateWorkBooks()
Dim ws As Object
Dim i As Long
Dim ws_num As Integer
Application.ScreenUpdating = False
Set ws = Worksheets
ws_num = ThisWorkbook.Worksheets.Count
For i = 2 To ws_num
'Copy one worksheet as a new workbook
'The new workbook becomes the ActiveWorkbook
ws.Copy
'Replace all formulas with values (optional)
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
'May want (not required) to add a file name extension (.xls or .xlsx) to the file name
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & _
"AR Balance- " & ActiveSheet.Name & " " & Worksheets("DATA Sheet").Range("m2") & ".xlsx"
ActiveWorkbook.Close SaveChanges:=False
Next
Application.ScreenUpdating = True
End Sub
Welcome to SO. Only simple self explanatory corrections made. Try
Option Explicit
Sub CreateWorkBooks()
Dim ws As Worksheet ' Worksheets instead of Object
Dim i As Long
Dim ws_num As Integer
'Application.ScreenUpdating = False
ws_num = ThisWorkbook.Worksheets.Count
For i = 2 To ws_num
Set ws = ThisWorkbook.Worksheets(i) 'set ws to each sheet in the workbook
'Copy one worksheet as a new workbook
'The new workbook becomes the ActiveWorkbook
ws.Copy
'Replace all formulas with values (optional)
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
'May want (not required) to add a file name extension (.xls or .xlsx) to the file name
' Thisworkbook is to be added to refer Worksheets("DATA Sheet").Range("m2").Value
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & _
"AR Balance- " & ActiveSheet.Name & " " & ThisWorkbook.Worksheets("DATA Sheet").Range("m2").Value & ".xlsx"
ActiveWorkbook.Close False
Next
'Application.ScreenUpdating = True
End Sub
I have a Userform with a Listbox and a Export button. The Listbox will list all the Sheet names in the workbook. I want to be able to select the sheet names in the list box and click on export to make a copy in the desktop that creates a paste only value & formatting (without the formula and form buttons on the original sheet).
So for I was successful in listing the sheet name in the listbox, but I am having some trouble with the export button code, I get out of range error.
Private Sub CommandButton1_Click()
Dim lSht As Long
Dim wb As Workbook
Dim sPath As String
Dim sSheet As String
Dim NewWbName As String
Dim i As Long
'Set variables
Set wb = Workbooks.Add
'Add a filepath to your computer below
sPath = "C:\Users\" & Environ("USERNAME") & "\Desktop\"
NewWbName = "Reports " & Format(Now, "yyyy_mm_dd _hh_mm")
i = 1
'Loop through listbox
For lSht = 0 To Me.sheetlist.ListCount - 1
'check if items selected
If Me.sheetlist.Selected(lSht) = True Then
'copy out the sheet and saveas
sSheet = Me.sheetlist.List(lSht)
With wb.Worksheets(sSheet).Copy
.PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteFormats)
End With
Application.DisplayAlerts = False
wb.SaveAs Filename:=DesktopPath & NewWbName, FileFormat:=xlNormal
wb.Close
MsgBox "You can find the export file in your desktop.", vbOKOnly + vbInformation, "Back Up Sucessful!"
Application.DisplayAlerts = True
End If
Next lSht
End Sub
Following or comments above, try the code below:
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim newWb As Workbook
Dim sPath As String
Dim sSheet As String
Dim NewWbName As String
Dim lSht As Long
Dim NewSht As Worksheet
Dim i As Long
Dim firstExport As Boolean
'Set variables
Set wb = ThisWorkbook
Set newWb = Workbooks.Add
Application.DisplayAlerts = False
firstExport = True
'Add a filepath to your computer below
sPath = "C:\Users\" & Environ("USERNAME") & "\Desktop\"
NewWbName = "Reports " & Format(Now, "yyyy_mm_dd _hh_mm")
'Loop through listbox
For lSht = 0 To Me.sheetlist.ListCount - 1
'check if items selected
If Me.sheetlist.Selected(lSht) = True Then
'copy out the sheet and saveas
sSheet = Me.sheetlist.List(lSht)
If firstExport Then
firstExport = False
' remove all sheets (exceot 1) in first Copy>Paste
For i = newWb.Sheets.Count - 1 To 1 Step -1
newWb.Sheets(i).Delete
Next i
' add new sheet to new workbook and put it at theend
Set NewSht = newWb.Sheets(newWb.Sheets.Count)
Else
' add new sheet to new workbook and put it at the end
Set NewSht = newWb.Sheets.Add(After:=newWb.Sheets(newWb.Sheets.Count))
End If
NewSht.Name = sSheet
With wb.Sheets(sSheet)
.Cells.Copy
NewSht.Cells.PasteSpecial (xlPasteValues)
NewSht.Cells.PasteSpecial (xlPasteFormats)
End With
End If
Next lSht
' need to move the save workbook outside the Copy all selected sheets "loop"
newWb.SaveAs Filename:=sPath & NewWbName, FileFormat:=xlNormal
newWb.Close True
MsgBox "You can find the export file in your desktop.", vbOKOnly + vbInformation, "Back Up Sucessful!"
Application.DisplayAlerts = True
End Sub