I have an Excel Sheet Named "Las" and I need to Save it as Las file. I have the following code and it used to work fine but for some reason it stopped saving the Las file. Any help will be appreciated.
VBA Code:
Dim CC, RC As Integer
Dim fso As FileSystemObject
Dim oFile As TextStream
Sheets("Scratch").Select
For N = 2 To 8
Str1 = Cells(N, "D")
pos1 = InStr(1, Str1, "Data", vbTextCompare)
If pos1 > 0 Then
Lrnum = Cells(N, "E")
Exit For
End If
Next N
Sheets("Scratch").Select
Range(Cells(1, 1), Cells(Lrnum, 1)).Copy
Worksheets("Scratch").Range("A1:A" & Lrnum).Copy _
Destination:=Worksheets("Las").Range("A1")
Sheets("Log Data").Select
Cells(2, 1).Select
CC = Selection.End(xlToRight).Column
For N = 1 To CC
Str1 = Cells(1, N)
Str2 = Str2 & " " & Str1
Next N
Sheets("Las").Select
Cells(Lrnum + 1, 1).Select
Selection.Value = Str2
Sheets("unwrap1").Select
Cells(1, 15).Select
rrnum = Selection.End(xlDown).Row
Worksheets("unwrap1").Range(Cells(1, 15), Cells(rrnum, 15)).Select
Selection.Copy
Sheets("Las").Select
Cells(Lrnum + 2, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Las").Select
TRC = Selection.End(xlDown).Row
Dim Arr1() As Variant
ReDim Arr1(1 To TRC, 1 To 1)
Arng = Range(Cells(1, 1), Cells(TRC, 1)).Address
Arr1() = Range(Arng)
Range("A1").Select
Dim FolderName As String
Fnm1 = Sheets("Scratch").Cells(1, 100)
pos1 = InStr(1, Fnm1, " ", vbTextCompare)
Fnm2 = Left(Fnm1, pos1)
Fnm = Fnm2 & " " & "Unwrapped" & ".las"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFile = fso.CreateTextFile(Fnm)
For j = 1 To UBound(Arr1, 1)
Str1 = Arr1(j, 1)
oFile.WriteLine (Str1)
Next j
oFile.Close
LasPath1 = Sheets("Scratch").Cells(2, 100)
LL = Len(LasPath1)
pos1 = InStrRev(LasPath1, "\")
LasPath = Left(LasPath1, pos1)
Lasnm = Mid(LasPath1, pos1 + 1, LL - pos1)
Set oFile = Nothing
MsgBox "Las File " & Lasnm & vbNewLine & "has been Created" & vbNewLine & "You Can Find it in Folder " & LasPath & " """
Sheets("Start").Select
Last edited by a moderator: