- Katılım
- 22 Aralık 2008
- Mesajlar
- 43
- Excel Vers. ve Dili
- OFFİCE 2007/EXCEL 2007 TÜRKÇE
- Altın Üyelik Bitiş Tarihi
- 17-11-2024
AŞAĞIDAKİ ŞEKİLDE 1 BİR VBA PROJEMİZ VAR.BU FORMÜLDEKİ J13 HÜCRESİNDEKİ DEĞER DİĞER 3 TEKLİF FORMATIMIZDAKİ ALANLARDADA DOSYALAR KAPALI İKEN OTOMATİK GÜNCELLESİN İSTİYORUZ.
Sub KAPAT()
[M1].Value = [M1].Value + 1
[j13] = "T" & [M1].Text
ActiveWorkbook.Save
Workbooks.Open Filename:=ThisWorkbook.Path & "/VERİLEN TEKLİFLER GENEL DURUM.xls"
Windows("TEKLİF ŞABLONU-YTL 1.xls").Activate
[b13].Copy
Windows("VERİLEN TEKLİFLER GENEL DURUM.xls").Activate
Range("B" & [B65536].End(3).Row + 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Workbooks.Open Filename:=ThisWorkbook.Path & "/VERİLEN TEKLİFLER GENEL DURUM.xls"
Windows("TEKLİF ŞABLONU-YTL 1.xls").Activate
[j13].Copy
Windows("VERİLEN TEKLİFLER GENEL DURUM.xls").Activate
Range("A" & [A65536].End(3).Row + 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Windows("TEKLİF ŞABLONU-YTL 1.xls").Activate
Windows("VERİLEN TEKLİFLER GENEL DURUM.xls").Close
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "/A.xls", FileFormat:= _
xlNormal, ReadOnlyRecommended:=False _
, CreateBackup:=False
MsgBox " İşlem Tamamdır..."
End Sub
Sub KAPAT()
[M1].Value = [M1].Value + 1
[j13] = "T" & [M1].Text
ActiveWorkbook.Save
Workbooks.Open Filename:=ThisWorkbook.Path & "/VERİLEN TEKLİFLER GENEL DURUM.xls"
Windows("TEKLİF ŞABLONU-YTL 1.xls").Activate
[b13].Copy
Windows("VERİLEN TEKLİFLER GENEL DURUM.xls").Activate
Range("B" & [B65536].End(3).Row + 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Workbooks.Open Filename:=ThisWorkbook.Path & "/VERİLEN TEKLİFLER GENEL DURUM.xls"
Windows("TEKLİF ŞABLONU-YTL 1.xls").Activate
[j13].Copy
Windows("VERİLEN TEKLİFLER GENEL DURUM.xls").Activate
Range("A" & [A65536].End(3).Row + 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Windows("TEKLİF ŞABLONU-YTL 1.xls").Activate
Windows("VERİLEN TEKLİFLER GENEL DURUM.xls").Close
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "/A.xls", FileFormat:= _
xlNormal, ReadOnlyRecommended:=False _
, CreateBackup:=False
MsgBox " İşlem Tamamdır..."
End Sub
