Auto Closing and Deleting Data

[danenorman13]

I wrote a macro that auto plays when the workbook is opened, it adds data delimits, pastes into sheet 2 then copies sheet 2 and pastes in a new workbook. It is then supposed to close the code workbook and leave Book 1 open to save as. For some reason when it closes the code it also is deleting the data out of my new workbook, what can be causing this? Excel 2010

Here is my code:

Private Sub Workbook_Open()
Dim sPath As String
Dim fName As String
Dim s As String
s = "C:\"
' change to where you want the dialog to point
' to when it is displayed
sPath = "C:\"
ChDrive sPath
 
fName = Application.GetOpenFilename( _
Filefilter:="Data Files (*.dat),*.dat")
ChDrive s
ChDir s
 
Application.ScreenUpdating = False
If LCase(fName) = "false" Then Exit Sub
With ActiveSheet.QueryTables.Add _
(Connection:="TEXT;" & fName, _
Destination:=Range("A1"))
.Name = Replace(LCase(fName), ".txt", "")
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(4, 2, 7, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
 
Columns("B:D").Select
Selection.Delete Shift:=xlToLeft
 
Cells.Replace what:="PA", Replacement:="E-12", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace what:="NA", Replacement:="E-9", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Find(what:="MV", after:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Cells.Replace what:="MV", Replacement:="E-3", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace what:="M", Replacement:="E-3", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace what:="V", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
 
Sheets("Sheet2").Select
Sheet2.Range("A1").Select
ActiveCell.FormulaR1C1 = "Run/Part#"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheet2.Range("B1").Select
ActiveCell.FormulaR1C1 = "T1 BVDSS (V)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = "T20 BVDSS (V)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.FormulaR1C1 = "T22 VGSTH (V)"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "T24 VGSTH (V)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.FormulaR1C1 = "T26 IGSSR (A)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.FormulaR1C1 = "T27 IGSSF (A)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.FormulaR1C1 = "T29 IDSS (A)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.FormulaR1C1 = "T31 RDSON (Ohm)"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "T33 RDSON (Ohm)"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "T35 RDSON (Ohm)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.FormulaR1C1 = "T37 BVDSS (V)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.FormulaR1C1 = "T39 VGSTH (V)"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "T41 VGSTH (V)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.FormulaR1C1 = "T43 IGSSF (A)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.FormulaR1C1 = "T44 IGSSR (A)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.FormulaR1C1 = "T46 IDSS (A)"
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
ActiveCell.FormulaR1C1 = "T48 RDSON (Ohm)"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "T50"
Sheets("Sheet2").Select
ActiveCell.Select
ActiveCell.FormulaR1C1 = "T50 RDSON (Ohm)"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "T52 RDSON (Ohm)"
Columns("A:S").Select
Range("S1").Activate
Columns("A:S").EntireColumn.AutoFit
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A6000"), Type:=xlFillSeries
Sheets("Sheet1").Select
 
Do
Range("B4:B21").Select
Selection.Copy
Sheets("Sheet2").Select
Range("B65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
 
Sheets("Sheet1").Select
Rows("4:24").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Loop Until IsEmpty(ActiveCell)
Sheets("Sheet2").Select
Range("B65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, -1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A1").Select
 
Application.ScreenUpdating = True
 
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Range("A1").Select
 
Windows("Working Code").Activate
Application.CutCopyMode = False
ActiveWindow.Close False
Application.DisplayAlerts = False
 
Workbooks("Book 1").Activate
End Sub

Thanks for your help!