K
KENNY
Can't seem to get Excel to quit with: Application.quit
Can anyone help per the code below?! TIA!
Sub Auto_Open()
Dim PathSrc As String, PathDest As String
Dim srcList As Variant
Dim i As Long, sDest As String
Dim bkSrc As Workbook, bkDest As Workbook
Dim srcList1 As Variant, NumFiles As Long
PathSrc = "Y:\Sales\Target Customer\2005 Mainframe
Download\"
PathDest = "Y:\Sales\Target Customer\2005 Mainframe
Download - Main\"
Workbooks.Open "C:\Target\Supplant\Supplant.xls"
NumFiles = ActiveWorkbook.Worksheets("Sheet1").Range("D1")
srcList1 = ActiveWorkbook.Worksheets("Sheet1").Range
("B1").Resize(NumFiles, 1).Value
Workbooks("Supplant.xls").Close SaveChanges:=False
ReDim srcList(1 To NumFiles)
For i = 1 To NumFiles
srcList(i) = srcList1(i, 1)
Next
For i = LBound(srcList) To UBound(srcList)
Set bkSrc = Workbooks.Open(PathSrc & srcList(i))
sDest = bkSrc.Name
sDest = Left(sDest, Len(sDest) - 4) & "M.xls"
Set bkDest = Workbooks.Open(PathDest & sDest)
bkSrc.Worksheets(1).Rows(1).Resize(1000).Copy _
Destination:=bkDest.Worksheets(1).Range("A1")
bkSrc.Close SaveChanges:=False
Application.DisplayAlerts = False
bkDest.SaveAs bkDest.FullName, xlWorkbook
bkDest.Close SaveChanges:=False
Application.DisplayAlerts = True
Next
Workbooks("RAW VBA.xls").Close SaveChanges:=False
Application.Quit
End Sub
Can anyone help per the code below?! TIA!
Sub Auto_Open()
Dim PathSrc As String, PathDest As String
Dim srcList As Variant
Dim i As Long, sDest As String
Dim bkSrc As Workbook, bkDest As Workbook
Dim srcList1 As Variant, NumFiles As Long
PathSrc = "Y:\Sales\Target Customer\2005 Mainframe
Download\"
PathDest = "Y:\Sales\Target Customer\2005 Mainframe
Download - Main\"
Workbooks.Open "C:\Target\Supplant\Supplant.xls"
NumFiles = ActiveWorkbook.Worksheets("Sheet1").Range("D1")
srcList1 = ActiveWorkbook.Worksheets("Sheet1").Range
("B1").Resize(NumFiles, 1).Value
Workbooks("Supplant.xls").Close SaveChanges:=False
ReDim srcList(1 To NumFiles)
For i = 1 To NumFiles
srcList(i) = srcList1(i, 1)
Next
For i = LBound(srcList) To UBound(srcList)
Set bkSrc = Workbooks.Open(PathSrc & srcList(i))
sDest = bkSrc.Name
sDest = Left(sDest, Len(sDest) - 4) & "M.xls"
Set bkDest = Workbooks.Open(PathDest & sDest)
bkSrc.Worksheets(1).Rows(1).Resize(1000).Copy _
Destination:=bkDest.Worksheets(1).Range("A1")
bkSrc.Close SaveChanges:=False
Application.DisplayAlerts = False
bkDest.SaveAs bkDest.FullName, xlWorkbook
bkDest.Close SaveChanges:=False
Application.DisplayAlerts = True
Next
Workbooks("RAW VBA.xls").Close SaveChanges:=False
Application.Quit
End Sub