Open Text Files/Format/Save as .xls for multiple files.
I put the module in the same workbook that the data gets pulled into. The
macro creates the right number of tabs with the proper headings. however, it
does not pull the data into the tabs. Meaning that I have 68 tabs with
header info, but no data.
"Joel" wrote:
I'm suprised that the error occured here. Was it a compile error or a run
time error? The code is trying to add a worksheet to the workbook where the
macro is located. There is no limit to the number of sheets that can be
added. I made a simple macro to check the line and it works fine for me??????
Sub test1()
With ThisWorkbook
Set NewSht = .Sheets.Add( _
after:=.Sheets(Sheets.Count))
End With
End Sub
Maybe the workbook is protected where you are runing the macro.
"Ray" wrote:
Joel,
Thanks for the reply. I did try your code but I got an error at
Set NewSht = .Sheets.Add( _
after:=.Sheets(Sheets.Count))
"Joel" wrote:
See if this works.
Sub combine()
FolderName = "D:\Biolum\Survey Data" '\600708\Cast001
ChDrive "D"
ChDir FolderName
Set fs = CreateObject("Scripting.FileSystemObject")
Set Folder = _
fs.GetFolder(FolderName)
If Folder.subfolders.Count 0 Then
For Each Sf In Folder.subfolders
With ThisWorkbook
'Create New Sheet
Set NewSht = .Sheets.Add( _
after:=.Sheets(Sheets.Count))
NewSht.Name = Sf.Name
With NewSht
.Range("B1") = "RecNbr"
.Range("C1") = "Time"
.Range("D1") = "Depth"
.Range("E1") = "BIO cps"
.Range("F1") = "NDx"
.Range("G1") = "RTmp"
.Range("H1") = "CHL"
.Range("I1") = "Cnd"
.Range("J1") = "Trans"
.Range("K1") = "LSS"
.Range("L1") = "Batt"
.Range("M1") = "Lat"
.Range("N1") = "Long"
For Each Myfile In Folder.Files
LastRow = .Range("B" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
With .QueryTables.Add( _
Connection:="TEXT;" & Myfile.Path, _
Destination:=.Range("A" & NewRow))
.Name = Myfile.Path
.TextFileParseType = xlDelimited
.TextFileTextQualifier = _
xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next Myfile
End With
End With
Next Sf
ThisWorkbook.Save
End If
End Sub
"Ray" wrote:
This may be complicated so please bear with me. I have 68 .txt files that I
need to open in excel and delete some header information. Then I need to
save the file as an .xls. I have managed to develop the code to do one file
but I would like to create a Loop of sorts to do the rest without having to
write the code for each file. For one file the code looks like:
ChDir "D:\Biolum\Survey Data\600708\Cast001"
Workbooks.OpenText Filename:= _
"D:\Biolum\Survey Data\600708\Cast001\60070801.txt", Origin:=437,
StartRow _
:=30, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=False, 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), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1)),
TrailingMinusNumbers _
:=True
With ActiveWindow
.Width = 791.25
.Height = 599.25
End With
ActiveWindow.SmallScroll Down:=-18
Rows("1:1").Select
Selection.Insert Shift:=x1Down
Range("B1").Select
ActiveCell.Formula = "RecNbr"
Range("C1").Select
ActiveCell.Formula = "Time"
Range("D1").Select
ActiveCell.Formula = "Depth"
Range("E1").Select
ActiveCell.Formula = "BIO cps"
Range("F1").Select
ActiveCell.Formula = "NDx"
Range("G1").Select
ActiveCell.Formula = "Tmp"
Range("H1").Select
ActiveCell.Formula = "CHL"
Range("I1").Select
ActiveCell.Formula = "Cnd"
Range("J1").Select
ActiveCell.Formula = "Trans"
Range("K1").Select
ActiveCell.Formula = "LSS"
Range("L1").Select
ActiveCell.Formula = "Batt"
Range("M1").Select
ActiveCell.Formula = "Lat"
Range("N1").Select
ActiveCell.Formula = "Long"
ActiveWorkbook.SaveAs Filename:= _
"D:\Biolum\Survey Data\600708\60070801.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close
What will change for each file is the Cast number (Cast001, Cast002, etc)
and the file name (60070801.xls, 60070802.xls, etx).
Any help will be greatly appreciated.
Cheers,
-Ray
And while I'm at it, I plan to combine each file into a master workbook
with each cast on it's own tab. Any help with that would be great as well.
|