I have a main excel file with macro which copies data to a newly created file.
When I run the below part of code in Excel 2016 everything works correctly - new workbook closes and "Completed" message is displayed.
But when I run it in Excel 365, csv is successfully exported, but the main file closes instead of the newly created file and I never see the "Completed" message.
I use both Excel files remotely, so there might be delay involved.
' copy table to a new sheet and export to csv
tbl.Range.Copy
Workbooks.Add
ActiveSheet.Paste
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
fcsv _
, FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True
MsgBox "Completed"
Use a workbook variable and avoid ActiveWorkbook (or ActiveSheet).
Dim wb As Workbook
Set wb = Workbooks.Add
Dim ws As Worksheet
Set ws = wb.Worksheets(1)
tbl.Range.Copy ws.Range("A1") '<~ copy/paste in one line
Application.DisplayAlerts = False
wb.SaveAs Filename:= _
fcsv _
, FileFormat:=xlCSV, CreateBackup:=False
wb.Close SaveChanges:=False
Application.DisplayAlerts = True
MsgBox "Completed"
Related
I am trying to copy a dynamic range(dyna) from activesheet and paste it to a new workbook located in "E:\1b\", file name based on cell value(J7).
Below is the formula in the dynamic range:
dyna = "=OFFSET(Sheet1!$D$6,0,0,COUNTA(Sheet1!$D:$J),7)"
I need help to do it.
here is code I have
Set wb = Workbooks.Add
ThisWorkbook.Activate
ActiveSheet.dyna.Copy Before:=wb.Sheets(1)
wb.Activate
Application.DisplayAlerts = False
wb.SaveAs "E:\1b\" & Range("J7").Value & ".xlsx",
FileFormat:=xlOpenXMLWorkbook, ReadOnlyRecommended:=False, CreateBackup:=False
wb.Close "E:\1b\" & Range("J7").Value & ".xlsx"
Application.DisplayAlerts = True
End Sub
I need to convert all sheets within a excel file to csv . I also need to delete the top two rows. Output file to should be saved in folder (ProductSheets) to be created within the existing original file location.
I tried below code but on running the code leaves all sheets opened individually which i have to manually close it.
Sub ExportSheetsToCSV()
Application.DisplayAlerts = False
Dim newWs As Worksheet
Dim CurrentWB As Workbook, TempWB As Workbook
Dim filepath As String
For Each newWs In Application.ActiveWorkbook.Worksheets
newWs.Copy
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
Range("1:2").Delete
If Len(Dir(ThisWorkbook.Path & "\ProductSheets", vbDirectory)) = 0 Then
filepath = ThisWorkbook.Path
MkDir (filepath & "\ProductSheets")
End If
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ProductSheets\" & newWs.Name & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
Application.ActiveWorkbook.Saved = True
Application.ActiveWorkbook.Close
Next
End Sub
The above code leaves all sheets open individually.
The below code is added to save all cells with formula which other wise would output as ref error
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
The line newWs.Copy creates a copy of the existing sheet as a new workbook. As such you don't need some of the rest of your code. I'd do it as
Sub ExportAsCSVs()
Dim ws as worksheet
dim wb as workbook
for each ws in worksheets
ws.copy 'creates new workbook with one sheet
set wb = activeworkbook 'this is the workbook created above
wb.sheets(1).rows("1:2").delete
wb.saveas Filename:=ThisWorkbook.Path & "\ProductSheets\" & Ws.Name & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
wb.close false
next ws
End Sub
I would like to convert delimited txt into xls file. I have come up with 2 very simple line of commands which I suppose should work but in reality it didn't. Can anyone tell me what mistakes I have made?
If this work, I am going to loop it with dir for 3000 txt files...
Thanks!
Bosco
Sub ConvertDelimitedTXTtoXLS()
Dim wb As Workbooks
wb.OpenText Filename:="C:\Users\boscotsin\Desktop\test0.txt", DataType:=xlDelimited, Tab:=True
wb.SaveAs Filename:="C:\Users\boscotsin\Desktop\success.xls"
End Sub
Sub delimitedTXTtoXLS()
Dim wb As Workbook
Workbooks.OpenText filename:="C:\Users\boscotsin\Desktop\test0.txt", origin:=xlMSDOS, DataType:=xlDelimited, Tab:=True
Set wb = ActiveWorkbook
wb.SaveAs filename:="C:\Users\boscotsin\Desktop\success.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
wb.Close SaveChanges:=True
End Sub
' Excel8
Sub delimitedTXTtoXLS2()
Dim wb As Workbook
Workbooks.OpenText FileName:="C:\Users\boscotsin\Desktop\test0.txt", origin:=xlMSDOS, DataType:=xlDelimited ', Comma:=True
Set wb = ActiveWorkbook
wb.SaveAs FileName:="C:\Users\boscotsin\Desktop\success.xlsx", FileFormat:=56, CreateBackup:=False
wb.Close SaveChanges:=True
End Sub
I am trying to create multiple Excel workbooks by separating out each worksheet in a single workbook with:
Sub Splitbook()
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
sht.Copy
'(I got an error here-copy method of worksheet class failed)
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\" & sht.Name & ".xls"
ActiveWorkbook.Close savechanges:=False
Next sht
End Sub
I have used the same code for a different workbook and it worked but am now seeing the copy method of worksheet class failed error.
Can anyone explain why and how to fix this please?
There are several complications with your code in order to perform the described task. I have modified your code in order to make it create individual workbooks out of all the worksheets in your active workbook.
Sub Splitbook()
Dim CurWb As Workbook, NewWb As Workbook
Dim MyPath As String
MyPath = ActiveWorkbook.Path
Set CurWb = ActiveWorkbook
Application.ScreenUpdating = False
'Loops through all sheets in active workbook
For Each CurWs In CurWb.Worksheets
'Copy sheet to new workbook
CurWb.Sheets(CurWs.Name).Copy After:=Workbooks.Add.Sheets(1)
Set NewWb = ActiveWorkbook
'Removes empty sheets, saves workbook and closes workbook
Application.DisplayAlerts = False
For Each NewWs In NewWb.Worksheets
If NewWs.Name <> CurWs.Name Then NewWs.Delete
Next NewWs
NewWb.SaveAs Filename:=MyPath & "\" & CurWs.Name & ".xls", FileFormat:=56
NewWb.Close SaveChanges:=False
Application.DisplayAlerts = True
Next CurWs
Application.ScreenUpdating = True
End Sub
I have modified your code to check the sheet which is copied is visible. Please give this a try and let me know the results.
Sub Splitbook()
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
If sht.Visible = True Then
sht.Copy
'(I got an error here-copy method of worksheet class failed)
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\" & sht.Name & ".xls"
ActiveWorkbook.Close savechanges:=False
End If
Next sht
End Sub
I have this code, although it states there is an error.
What i want to do is complete csv file export from the current active sheet, and save it with the information currently in cell A2.
Sub exportCSV()
' export Macro
Range("A:F").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
strName = AprilPayslips.Range("A2")
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & strName
, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = False
Application.DisplayAlerts = True
End Sub
If you want the value of a cell as a string then ask for it :)
strName = Range("A2").Value
These two lines won't do anything as they stand, so remove them:
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Paths should always include the trailing slash so you don't need to add that in:
Sub exportCSV()
strName = Range("A2").Value
Range("A:F").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & strName, FileFormat:=xlCSV, CreateBackup:=False
End Sub
Should work for you, however unless you can be sure that the contents of A2 will always be a valid filename you may run into problems unless you add in some extra validation.