Heading ## I was able to get the selection to select active Cell a1 but now receive error 1004 Application Object-defined error, AT THE SECTION OF CODE <Sheets.Add before:=Workbooks(myFile).Sheets("Make DMS Report")>
Please see the code below.
The code filters the data from Agile export and filters the product Part number and associates the manufacture part number with the part.
'Start code
<Sub ImportAgileBOM()
'GoTo test1
Dim FullFileName As String
Dim myFile As String
Dim FileFormat As String
Dim rng As Range
'Open .cvs worksheet and convert to text format.
myFile = ActiveWorkbook.Name
FullFileName = Application.GetOpenFilename("Text files , *.csv; *.txt,Excel files (*.xls*), *.xls*", 2, "Select Agile Mfr BOM Report", , False)
If FullFileName = "False" Then
Application.DisplayAlerts = True
End
End If
'This section converts the .cvs and renames workboot to text
If Right(FullFileName, 4) = ".csv" Or Right(FullFileName, 4) = ".txt" Then
FileCopy FullFileName, FullFileName & "importtemp.txt"
FileFormat = "Text"
Workbooks.OpenText Filename:=FullFileName & "importtemp.txt", _
DataType:=xlDelimited, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2))
Else
FileFormat = "Excel"
Workbooks.Open Filename:=FullFileName
End If
'Make Active Range
Set rng = ActiveSheet.Range("A1")
'Range("A1").Activate
If FileFormat = "Text" Then
If ActiveCell <> "Manufacturer BOM Report" Then
MsgBox "Input file not in Manufacturer BOM Report format"
ActiveWindow.Close
Application.DisplayAlerts = True
End
End If
ElseIf ActiveCell.Offset(0, 1) <> "Manufacturer BOM Report" Then
MsgBox "Input file not in Manufacturer BOM Report format"
ActiveWindow.Close
Application.DisplayAlerts = True
End
End If
'FullFileName = ActiveWorkbook.Name
'Sheets(ActiveSheet.Name).Copy Sheets.Add Sheet.before:=Workbooks(myFile).Sheets("Make DMS Report")
'Windows(FullFileName).Activate
'ActiveWindow.Close savechanges:=False
'Copy data to secound sheet
FullFileName = ActiveWorkbook.Name
Cells.Select
Selection.Copy
Workbooks(myFile).Activate
Sheets.Add before:=Workbooks(myFile).Sheets("Make DMS Report")
ActiveSheet.Paste>
'I receive the error when trying to add the created sheet to the Active sheet.
If you could assist in this issue it would be appreciated
I am now receiving an error at <Range("A1"). select> the error message is Run-time error 1004 Application-defined Or Object-defined error, I don't understand why I am receiving this error, just selecting a cell
Related
I am trying to import a large txt. file into excel. The whole process works, but is very time consuming (16-17 s). Is there any way to make it more time effective?
My code looks like this:
Sub Dane_wprowadz() ' icon folder
Dim Plik As String
Dim Katalog As String
Dim Sciezka As String
CzasStart = Timer
'Screen update hidden
Application.ScreenUpdating = False
'Gridline hidden
ActiveWindow.DisplayGridlines = False
'Import of txt file origin
Katalog = InputBox("Proszę podać katalog gdzie znajdują się dane", "Lokalizacja danych", ActiveWorkbook.Path & "\dane") & "\"
'New Sheet
Sheets.Add After:=Sheets(Sheets.Count)
'Headers in new sheet
ActiveSheet.Range("A1") = "Brand"
ActiveSheet.Range("B1") = "Produkt"
ActiveSheet.Range("C1") = "Tydzień"
ActiveSheet.Range("D1") = "Sprzedaż"
ActiveSheet.Range("E1") = "Województwo"
ActiveSheet.Range("F1") = "Miasto"
ActiveSheet.Range("A1").Select
'Import txt 1
Plik = Dir(Katalog)
Do While Plik <> ""
'Path import
Sciezka = Katalog & Plik
'Data import of the txt file
Workbooks.OpenText Filename:=Sciezka, _
Origin:=1250, StartRow:=2, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:="-", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
TrailingMinusNumbers:=True
'Copy imported data to "Dane
Selection.CurrentRegion.Copy (ThisWorkbook.Sheets("Dane").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
ActiveWindow.Close False 'close without saving
'Next txt file
Plik = Dir
Loop
'Start screen upadting
Application.ScreenUpdating = True
'Return to control panel
Sheets("Panel kontrolny").Select
CzasStop = Timer
MsgBox "Czas prodecury " & CzasStop - CzasStart & "s"
End Sub
It is probably the txt import that takes up the most time. Is there any way to make it more effective?
Unless VBA is necessary, you can use PowerQuery. I found it to be relatively faster and can do pretty much what you need.
Go Data->GetData->FromFile->FromText/CSV
I've borrowed some code from a post on this site already and made my own. However I'm running into a problem where the multiple files in my folder path are importing OVER the previous import instead of below the created list.
What I'm trying to achieve is importing data from multiple files in a specific folder location. After pursing through each file, the next import data should be placed under the previous import data in the worksheet.
Any insights on how to fix?
Thanks so much!
cwegz
Option Explicit
Const FOLDER_PATH = "Test Folder Path/" 'REMEMBER END BACKSLASH
Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row
rowTarget = 2
'check the folder exists
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If
'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False
'set up the target worksheet
Set wsTarget = Sheet1
'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""
'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY
'import the data
With wsTarget
.Columns("A").Value = wsSource.Columns("A").Value 'this one works
.Columns("B").Value = wsSource.Columns("C").Value 'this one works
'.Range("A1" & rowTarget).Value = wsSource.Columns("A").Value
'.Range("B1" & rowTarget).Value = wsSource.Columns("C").Value
'optional source filename in the last column
.Range("N" & rowTarget).Value = sFile
End With
'close the source workbook, increment the output row and get the next file
wbSource.Close SaveChanges:=False
rowTarget = rowTarget + 1
sFile = Dir()
Loop
errHandler:
On Error Resume Next
Application.ScreenUpdating = True
'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
Set Selection = Nothing
Sheets("Pull").Select
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="#", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Set Selection = Nothing
Sheets("Pull").Select
Columns("D:D").Select
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=";", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Set Selection = Nothing
Sheets("WhiteList").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="#", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Set Selection = Nothing
Sheets("Summary").Select
End Sub
Here's one approach, which should work if your data tables are consistent and contain no blank rows/columns.
Option Explicit
Const FOLDER_PATH = "Test Folder Path\" 'REMEMBER END BACKSLASH
Sub ImportWorksheets()
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet, rngData As Range, numRows As Long
Dim rowTarget As Long 'output row
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If
On Error GoTo errHandler
Application.ScreenUpdating = False
Set wsTarget = Sheet1
'get first empty row, assuming colA always has values
rowTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets(1)
Set rngData = wsSource.Range("A1").CurrentRegion '<< assumes no empty rows/columns in your data table
numRows = rngData.Rows.Count '<<
With wsTarget
.Cells(rowTarget, "A").Resize(numRows, 1).Value = rngData.Columns(1).Value
.Cells(rowTarget, "B").Resize(numRows, 1).Value = rngData.Columns(3).Value
'etc etc
.Cells(rowTarget, "N").Value = sFile 'optional source filename in the last column
End With
wbSource.Close SaveChanges:=False
rowTarget = rowTarget + numRows '<<
sFile = Dir()
Loop
'snipped....
End Sub
I currently have a macro set up that allows me to paste data into column A from Textpad and then sorts, rounds, moves and saves the data as a txt file.
Is there anyway that I can modify the macro to allow me to import the txt file straight into Excel rather than having to copy and paste? The file names changes each time, but the file directory will stay the same.
This is the current macro I have that is run after manually copy and pasting the data into excel:
'Sub SortRoundandSave()
'
' SortTruncateandSave Macro
' This macro will sort, round and save your data
'
'
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D" & Range("B" & Rows.Count).End(xlUp).Row)
Range("A:A,B:B,D:D").Select
Range("D1").Activate
Selection.Copy
Sheets("Truncated Data").Select
ActiveSheet.Paste
Sheets("Truncated Data").Select
Application.CutCopyMode = False
Sheets("Truncated Data").Move
ChDir "G:\XXXX\Folder\Name\ZZZZ\Sort"
ActiveWorkbook.SaveAs Filename:= _
"G:\XXXX\Folder\Name\ZZZZ\Sort\Sorted Data.txt", _
FileFormat:=xlText, CreateBackup:=False
Windows("Excel Truncator.xlsm").Activate
End Sub
I assume it needs a few lines before the text to columns part, but I cant seem to get one to work?
Any help would be greatly appreciated.
Thanks
Try this:
Sub SortRoundandSave()
'
' SortTruncateandSave Macro
' This macro will sort, round and save your data
'
Dim workSht As Worksheet: Set workSht = ActiveSheet 'ThisWorkbook.Sheets("") ' Enter the name of sheet
Dim FilePath As String
Dim strLine As String
Dim rowCnt As Long
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select the file"
.Filters.Clear
.Filters.Add Description:="Text Files", Extensions:="*.txt"
'.InitialFileName = "G:\XXXX\Folder\Name" ' Optional: this is a startup directory, place the correct one and uncomment line
If .Show = 0 Then Exit Sub
FilePath = .SelectedItems(1)
End With
rowCnt = 1
Open FilePath For Input As #1
Do While Not EOF(1)
Line Input #1, strLine
workSht.Cells(rowCnt, 1) = strLine
rowCnt = rowCnt + 1
Loop
Close #1
With workSht
Range(.Cells(1, 1), .Cells(rowCnt - 1, 1)).TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
.Cells(1, 4).AutoFill Destination:=Range(.Cells(1, 4), .Cells(workSht.Cells(Rows.Count, 2).End(xlUp).Row, 4)) ' "D1:D" & Range("B" & Rows.Count).End(xlUp).Row)
Range(.Cells(1, 1), .Cells(1, 4)).EntireColumn.Copy Sheets("Truncated Data").Cells(1, 1)
End With
Sheets("Truncated Data").Move
ActiveWorkbook.SaveAs Filename:= _
"G:\XXXX\Folder\Name\ZZZZ\Sort\Sorted Data.txt", _
FileFormat:=xlText, CreateBackup:=False
workSht.Parent.Activate
End Sub
I have some vba code which loops through all csv-files in a folder. It saves a file but does not split text into columns.
When I step through the code using F8, I can see that the text is split to columns, but when reopening the modified file I can't see the text having been split.
I am trying to open each file, split text to columns, and then save and go to the next file. I want to this for all files in a folder of my choice. Each folder may contain thousands of files.
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.csv*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Change First Worksheet's Background Fill Blue
wb.Worksheets(1).Range("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=True, Comma:=True, Space:=True, Other:=True, OtherChar:= _
"|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1) _
, Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array( _
19, 1), Array(20, 1), Array(21, 1)), TrailingMinusNumbers:=True
Range("A1").Select
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
You may be saving the file back to csv. You should save the file in xlsx, this way:
wb.SaveAs Filename:=split(myfile, ".")(0), FileFormat:=xlOpenXMLWorkbook
And please apply #Luuklag's suggestion, too.
I have *.asc files to open, reformat, and then save as an Excel file with the same name as the original (with the xls extension).
I used the Macro Recorder and code I found online to open individual files and reformat them as desired. That part of the code works.
I cannot save as an Excel file. It gives me the Run Time error of 1004 Method ‘SaveAs’ of object ‘_Workbook’ failed. I have tried lots of different code I found online (still in there, just commented out) but none work.
Two questions:
Can you offer suggestions to fix the SaveAs problem?
Can you offer suggestions of how to automate the opening and saving of all the files in one folder?
Here is the code I have:
Sub OpenFormatSave()
'
' OpenFormatSave Macro
'
Dim StrFileName As String
Dim NewStrFileName As String
ChDir _
"C:\Users\Owner\Documents\work_LLRS\GoM\NASA_data\Satellite_files_GoM_3Dec2012"
StrFileName = Application.GetOpenFilename("NASA Files (*.asc), *.asc")
If TypeName(StrFileName) <> "Boolean" Then
Workbooks.OpenText Filename:=StrFileName, _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
End If
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Year"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Day_of_Year"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Longitude"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Latitude"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Chla_mg_m-3"
Range("F1").Select
ActiveCell.FormulaR1C1 = "POC_mmolC_m-3"
Range("G1").Select
ActiveCell.FormulaR1C1 = "SPM_g_m-3"
Range("H1").Select
ActiveCell.FormulaR1C1 = "aCDOM355_m-1"
Range("I1").Select
ActiveCell.FormulaR1C1 = "DOC_mmolC_m-3"
Range("J1").Select
ActiveCell.FormulaR1C1 = "L2_flags"
Columns("A:B").Select
Selection.NumberFormat = "0"
Columns("C:D").Select
Selection.NumberFormat = "0.0000"
Columns("E:E").Select
Selection.NumberFormat = "0.000"
Columns("F:F").Select
Selection.NumberFormat = "0.0"
Columns("G:H").Select
Selection.NumberFormat = "0.000"
Columns("I:I").Select
Selection.NumberFormat = "0.0"
Columns("J:J").Select
Selection.NumberFormat = "0.00E+00"
'Mid(StrFileName, 1, InStrRev(StrFileName, ".")) = "xlsm"
'With ActiveWorkbook
'NewStrFileName = Replace(.StrFileName, ".asc", ".xls")
' .SaveAs Filename:=FullName, FileFormat:=xlsx, AddToMRU:=False
' .Close SaveChanges:=True
'End With
StrFileName = ThisWorkbook.Name
GetName:
StrFileName = Application.GetSaveAsFilename(NewStrFileName, _
fileFilter:="(*.xlsm), *.xlsm, (*.xlsx), *.xlsx,(*.xls), *.xls")
' FileMonth is the Workbook name, filter options to save a older version file
'If Dir(NewStrFileName) = "" Then
' ActiveWorkbook.SaveAs NewStrFileName
'Else
' If MsgBox("That file exists. Overwrite?", vbYesNo) = vbNo Then GoTo GetName
' Application.DisplayAlerts = False
' ActiveWorkbook.SaveAs Filename:=NewStrFileName, FileFormat:=xlsx, AddToMRU:=False
'Application.DisplayAlerts = True
'End If
'ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.SaveAs Filename:=NewStrFileName, FileFormat:=xlsx, CreateBackup:=False
'With ThisWorkbook
'FullName = Replace(.StrFileName, ".asc", ".xlsx")
'.Save
'.SaveAs StrFileName, FileFormat:=xlsx
'.Close
'SaveChanges:=True
'End With
'StrFileName = Split(ActiveWorkbook.FullName, ".xls")(0)
'ActiveWorkbook.SaveAs Filename:="...", FileFormat:=xlsx, AddToMRU:=False
'ActiveWorkbook.Close SaveChanges:=True
'ActiveWorkbook.Save
End Sub
Change the FileFormat portion of your SaveAs method to this:
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
To iterate through all the files in a folder, you have two options.
Use the built-in VBA Dir function.
Use methods in FileSystemObject.
I'll give an example of Dir because it doesn't require adding a reference in your VBA project. Unfortunately the Dir interface is a lot less intuitive and less modern than FileSystemObject.
Dim path As String
path = Dir("C:\Users\example\Documents\AscFiles\*.asc")
Do
If path = vbNullString Then Exit Do
' do something with path here
Debug.Print path
path = Dir
Loop
You have two variables StrFileName (presumably intended as the current filename) and NewStrFileName (presumably intended to be the new filename).
In this piece of code:
StrFileName = Application.GetSaveAsFilename(NewStrFileName, _
fileFilter:="(*.xlsm), *.xlsm, (*.xlsx), *.xlsx,(*.xls), *.xls")
you have used these variables the wrong way round. The suggested filename when the "Save As" dialog opens is based on NewStrFileName but this has never been given a value and is thus an empty string "". The value chosen by the user is then saved into StrFileName
When you come to save the file with this code:
ActiveWorkbook.SaveAs Filename:=NewStrFileName, FileFormat:=xlsx, _
CreateBackup:=False
the NewStrFileName variable still contains "" and thus you are trying to save a file without giving it a name which obviously produces an error.
For a simple fix, just swap the two variables in the call to GetSaveAsFilename:
NewStrFileName = Application.GetSaveAsFilename(StrFileName, _
fileFilter:="(*.xlsm), *.xlsm, (*.xlsx), *.xlsx,(*.xls), *.xls")
This is not the best way to achieve what you want but it should at least work
here is a very simply code to convert a folder of ASC files to Excel files. It also works with CSV files. So all you have to do is change the .asc to .csv
Just make sure you set the delimiter to TAB wherever you are getting the data from.
Sub import_ascFile()
Dim file As FileDialog
Dim filePath As String
Dim text As String
Dim wsheet As String
Application.DisplayAlerts = False
Application.StatusBar = True
wsheet = ActiveWorkbook.Name
Set file = Application.FileDialog(msoFileDialogFolderPicker)
file.Title = "Folder Selection:"
If file.Show = -1 Then
filePath = file.SelectedItems(1)
Else
Exit Sub
End If
If Right(filePath, 1) <> "\" Then filePath = filePath + "\"
text = Dir(filePath & "*.asc")
Do While text <> ""
Application.StatusBar = "Converting: " & text
Workbooks.Open Filename:=filePath & text
ActiveWorkbook.SaveAs Replace(filePath & text, ".asc", ".xlsx", vbTextCompare), xlWorkbookDefault
ActiveWorkbook.Close
Windows(wsheet).Activate
text = Dir
Loop
Application.StatusBar = False
Application.DisplayAlerts = True
End Sub