Export Data to CSV without closing source workbook

C

Connie

I have a workbook which is used by payroll clerks to input time sheet
data for employees. Based on the input, the spreadsheet performs
calculations on a separate sheet, and I would like to export that data
to a csv file. I created a command button to do this which contains
the following code. When the command is run, the CSV file is created;
however, the original workbook is closed and the user has to reopen it
to continue working. Is there any way to export data from a sheet in a
workbook to a CSV file without closing the original workbook?

Private Sub CreateUploadFile_Click()
Sheets("Upload Data").Select
Dim FName As String
FName = "Upload" & Format(Now(), "yyyymmmddhhmm")
ActiveSheet.Copy
ActiveSheet.SaveAs FName & ".csv", FileFormat:=xlCSV
MsgBox "Save File Complete"
End Sub

Any help would be great!

CJM
 
R

Ron de Bruin

Try this Connie

Private Sub CreateUploadFile_Click()
Dim FName As String
Dim wb As Workbook
FName = "Upload" & Format(Now(), "yyyymmmddhhmm")
Sheets("Upload Data").Copy
Set wb = ActiveWorkbook
wb.SaveAs FName & ".csv", FileFormat:=xlCSV
MsgBox "Save File Complete"

'If you want to close the csv file use
'wb.Close flase
End Sub
 
C

Connie

Ron: You code worked beautifully! I can't thank you enough. The only
issue is that when I close the file, I get the following prompt:

"Do You Want to Save the Changes You Made To FileName.csv". How would
I include that in the code so it automatically saves the changes. It's
strange that I get the prompt, as no changes were made.

Here's the code I'm using:

Private Sub CreateUploadFile_Click()
Dim FName As String
Dim wb As Workbook
FName = "Upload" & Format(Now(), "yyyymmmddhhmm")
Sheets("Upload Data").Copy
Set wb = ActiveWorkbook
wb.SaveAs FName & ".csv", FileFormat:=xlCSV
wb.Close flase
MsgBox "Save File Complete"
End Sub

Also, when the file is closed, the program automatically returns to the
sheet where the command button was launched (which is exactly what I
want). Is that because the Sheets("Upload Data").Copy command doesn't
actually select the sheet? In my prior code, I used Sheets("Upload
Data").Select to select the sheet before I did the save. This
positioned me on the data sheet after the save which is not what I
wanted. I like your code better! I'm learning!
 
T

Tom Ogilvy

Private Sub CreateUploadFile_Click()
Dim FName As String
Dim wb As Workbook
FName = "Upload" & Format(Now(), "yyyymmmddhhmm")
Sheets("Upload Data").Copy
Set wb = ActiveWorkbook
wb.SaveAs FName & ".csv", FileFormat:=xlCSV
wb.Close flase SaveChanges:=False
MsgBox "Save File Complete"
End Sub

The changes have already been saved, so saying false prevents saving it
again. If you don't trust it, specify true. In any event, you won't be
prompted fi you add the argument.
 
T

Tom Ogilvy

Forgot to clean it up:

wb.Close flase SaveChanges:=False

should be

wb.Close SaveChanges:=False
 
C

Connie

The code worked beautifully! Thanks so much to both of you; you've
made my life easier.
 
C

Connie

The code worked beautifully! Thanks so much to both of you; you've
made my life easier.
 
C

Connie

One more question: Rather than exporting the entire sheet to the CSV
file, is there a way to export a specific range?
 
R

Ron de Bruin

Hi Conny

To do this you must copy the range to a new workbook and save that

Try this tester that save the selection

Sub Tester()
Dim source As Range
Dim dest As Workbook
Dim strdate As String

Set source = Nothing
On Error Resume Next
Set source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If

If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine & _
"You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If

Application.ScreenUpdating = False
Set dest = Workbooks.Add(xlWBATWorksheet)
source.Copy
With dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
' Paste:=8 will copy the column width in Excel 2000 and higher
' If you use Excel 97 use the other example
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With

strdate = Format(Now, "dd-mm-yy h-mm-ss")
With dest
.SaveAs "Selection of " & ThisWorkbook.Name _
& " " & strdate & ".csv", FileFormat:=xlCSV
.Close False
End With
Application.ScreenUpdating = True
End Sub
 
C

Connie

Thanks, Ron. This worked!
Hi Conny

To do this you must copy the range to a new workbook and save that

Try this tester that save the selection

Sub Tester()
Dim source As Range
Dim dest As Workbook
Dim strdate As String

Set source = Nothing
On Error Resume Next
Set source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If

If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine & _
"You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If

Application.ScreenUpdating = False
Set dest = Workbooks.Add(xlWBATWorksheet)
source.Copy
With dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
' Paste:=8 will copy the column width in Excel 2000 and higher
' If you use Excel 97 use the other example
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With

strdate = Format(Now, "dd-mm-yy h-mm-ss")
With dest
.SaveAs "Selection of " & ThisWorkbook.Name _
& " " & strdate & ".csv", FileFormat:=xlCSV
.Close False
End With
Application.ScreenUpdating = True
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top