Option Explicit Sub Trial() ' ' Trial Macro ' ' Dim ws As Worksheet, lastrow As Long, lastcol As Long, startcell As Range, mycol As String, sheetName As String, subs() As String Set ws = ActiveSheet sheetName = "Sheet2" Worksheets("Sheet2").Activate Set startcell = Range("A1") lastrow = ws.Cells(ws.Rows.Count, startcell.Column).End(xlUp).Row lastcol = ws.Cells(startcell.Row, ws.Columns.Count).End(xlToLeft).Column mycol = GetColumnLetter(lastcol) MsgBox "A1:" & mycol & lastrow Sheets.Add After:=ActiveSheet MsgBox sheetName 'Worksheets("Sheet2").Activate 'MsgBox sheetName ActiveCell.FormulaR1C1 = _ "=IF(LEFT(CELL(""format""," & sheetName & "!RC))=""D"",TEXT(" & sheetName & "!RC,""mm/dd/yyyy hh:mm:ss""),IF(ISBLANK(" & sheetName & "!RC),""""," & sheetName & "!RC))" 'Worksheets("Sheet2").Activate 'MsgBox sheetName Range("A1").Select 'Worksheets("Sheet2").Activate 'MsgBox sheetName Selection.Copy 'Worksheets("Sheet2").Activate 'MsgBox sheetName Range("A1:" & mycol & lastrow).Select MsgBox "A1:" & mycol & lastrow ActiveSheet.Paste Application.CutCopyMode = False Application.DisplayAlerts = False 'ActiveWindow.SelectedSheets.Delete subs = Split(ActiveWorkbook.name, ".") ActiveWorkbook.SaveAs Filename:= _ ActiveWorkbook.Path & "\" & subs(0) & ".txt" _ , FileFormat:=xlUnicodeText, CreateBackup:=False 'ActiveWindow.SelectedSheets.Delete End Sub Function GetColumnLetter(colNum As Long) As String Dim vArr vArr = Split(Cells(1, colNum).Address(True, False), "$") GetColumnLetter = vArr(0) End Function