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
Related
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"
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 have a spreadsheet with lots of tabs. I am wanting to copy each tab into its own file which I can do with the code below.
My problem is adding an instruction sheet aswell to each of the new workbooks. I have an instruction sheet in the original workbook.
Your help would be appreciated.
Sub Splitbook()
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
sht.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\" & sht.Name & " SP Signoff.xlsx"
ActiveWorkbook.Close savechanges:=False
Next sht
End Sub
Sub Splitbook()
Dim wkb As Workbook
Dim wks As Worksheet, sht As Worksheet
Dim strPath As String
Set wkb = ThisWorkbook
Set wks = Sheets("Instructions")
strPath = wkb.Path
For Each sht In wkb.Sheets
If sht.Name <> "Instructions" Then
sht.Copy
With ActiveSheet
.Cells.Copy
.Cells.PasteSpecial Paste:=xlPasteValues
.Cells.PasteSpecial Paste:=xlPasteFormats
End With
wks.Copy Before:=ActiveWorkbook.Sheets(1)
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\" & sht.Name & " SP Signoff.xlsx"
ActiveWorkbook.Close savechanges:=False
End If
Next
End Sub
When I use the following code to:
save a macro-enabled workbook
in the same folder as the open workbook
it does save the file with the wrong name and on the desktop:
Sub Save_New_MacroEnabledFile()
Dim thisWb As Workbook
Set thisWb = ActiveWorkbook
Worksheets("Sheet_with_VBA_Button").Activate
ActiveWorkbook.SaveAs Filename:=thisWb.Path & Sheets("Sheet_with_NewFile's_Name").Range("A2"), FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, Password:=vbNullString, WriteResPassword:=vbNullString, _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
What am I doing wrong?
You didn't add slash when you creating new filepath.
Probably the folder where you have this file is on the desktop and without slash it just append the name of the file to the name of the folder, i.e.
folder was:
C:\Users\Antoine\Desktop\Folder
and after appending the filename without slash it was like:
C:\Users\Antoine\Desktop\Folderfilename.xlsx
Try this code:
Sub Save_New_MacroEnabledFile()
Dim thisWb As Workbook
Dim fileName As String
Set thisWb = ActiveWorkbook
Worksheets("Sheet_with_VBA_Button").Activate
Application.DisplayAlerts = False
fileName = thisWb.Path & "\" & Sheets("Sheet_with_NewFile's_Name").Range("A2") & VBA.IIf(Right(fileName, 5) = ".xlsm", "", ".xlsm")
ActiveWorkbook.SaveAs fileName:=fileName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:=vbNullString, WriteResPassword:=vbNullString, _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = 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