Başvurunun alındığı kitabın otomatik kapatılması

S

siar

Katılım
11 Mart 2005
Mesajlar
201
Excel Vers. ve Dili
2007 TR
Merhabalar,

Kullanmakta olduğum, "transfer" kitabı, "trf" kitabından verileri alarak, "transfer" kitabındaki "List" sayfasında değerleri aktarıyor. Değerlerin aktarımı bittikten sonra "trf" kitabını kapatıyor. Fakat "trf" kitabı kapatılırken, değişiklikleri kaydetmek istiyor musunuz? sorusunu çıkarıyor ve buraya hayır diyerek "trf" kitabını kapatıyoruz. Burada yapmak istediğimiz; bu soruyu pencereye getirmeden hayır komutunu seçerek "trf" kitabının otomatik kapanması. Kullandığımız kod aşağıdadır.

Sub List_Up_Date()

Range("A7:T2000").Select
Selection.ClearContents
Range("A7").Select
ActiveCell.FormulaR1C1 = "p"
Range("A11").Select

Workbooks.Open Filename:="C:\Transfer\trf.xls"
Cells.Select
With Selection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:4").Select
Selection.ClearContents
Columns("A:A").Select
Selection.Copy
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A7:A8").Select
Range("A8").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Columns("A:A").ColumnWidth = 17.14
Columns("A:A").Select
Selection.Replace What:="*/*/200? *", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Rows("7:7").Select
Selection.ClearContents
Range("B7").Select

Range("A6:N1000").Select
ActiveWindow.LargeScroll Down:=-25
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:="=*page*", Operator:=xlAnd
Rows("82:1000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=9, Criteria1:="Guest Name"
Rows("88:1000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=9, Criteria1:="="
Rows("7:1000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=9
ActiveWindow.SmallScroll Down:=224
ActiveWindow.LargeScroll Down:=-5
Range("A7:N1000").Select
Selection.Copy
Windows("transfer.xls").Activate
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("trf.xls").Activate
ActiveWorkbook.Close

Columns("H:H").Select
Selection.Copy
Columns("I:I").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Columns("H:H").Select
Selection.Replace What:="&*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("I:I").Select
Selection.Replace What:="*&", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("I9").Select
ActiveCell.FormulaR1C1 = "C"
Columns("I:I").Select
Columns("I:I").EntireColumn.AutoFit
Range("B7").Select

Range("P9:q9").Select
Selection.AutoFill Destination:=Range("P9:q999"), Type:=xlFillDefault
Range("P9:q999").Select
Range("B5").Select
End Sub
 
A

alpi

Katılım
22 Haziran 2005
Mesajlar
998
Excel Vers. ve Dili
Office 2007 Türkçe
Kırmızı renkli satırı değiştiriniz.


Sub List_Up_Date()

Range("A7:T2000").Select
Selection.ClearContents
Range("A7").Select
ActiveCell.FormulaR1C1 = "p"
Range("A11").Select

Workbooks.Open Filename:="C:\Transfer\trf.xls"
Cells.Select
With Selection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:4").Select
Selection.ClearContents
Columns("A:A").Select
Selection.Copy
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A7:A8").Select
Range("A8").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Columns("A:A").ColumnWidth = 17.14
Columns("A:A").Select
Selection.Replace What:="*/*/200? *", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Rows("7:7").Select
Selection.ClearContents
Range("B7").Select

Range("A6:N1000").Select
ActiveWindow.LargeScroll Down:=-25
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:="=*page*", Operator:=xlAnd
Rows("82:1000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=9, Criteria1:="Guest Name"
Rows("88:1000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=9, Criteria1:="="
Rows("7:1000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=9
ActiveWindow.SmallScroll Down:=224
ActiveWindow.LargeScroll Down:=-5
Range("A7:N1000").Select
Selection.Copy
Windows("transfer.xls").Activate
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("trf.xls").Activate
ActiveWorkbook.Close False

Columns("H:H").Select
Selection.Copy
Columns("I:I").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Columns("H:H").Select
Selection.Replace What:="&*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("I:I").Select
Selection.Replace What:="*&", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("I9").Select
ActiveCell.FormulaR1C1 = "C"
Columns("I:I").Select
Columns("I:I").EntireColumn.AutoFit
Range("B7").Select

Range("P9:q9").Select
Selection.AutoFill Destination:=Range("P9:q999"), Type:=xlFillDefault
Range("P9:q999").Select
Range("B5").Select
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst