Makro ile güncelleştirme

[kardelen79]

bu şekilde makro yazdım ekcel sayfasını açıp kaydedip aynı anda kapattırıyorum .burada her seferinde güncelleştirme yapılması için uyarı çıkıyor onu kendi okeyleyip excel sayfasını kapatmasını istiyorum birde bu sayfalardan 300 tane var hepsini açıp verileri gelmesini saglayıp kaydedip kapatma işlemini yapmak istiyorum .Her sayfanın yolunu yazmam mı gerekir Şimdiden teşekkür ederim




Sub dosyaac()
On Error GoTo hatakontrol
Dim w1 As Workbook
Dim w2 As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set w1 = Workbooks.Open(ThisWorkbook.Path & "\BİROL OYAK\ADESE.xlsx")
'MsgBox Sheets(1).Range("a1").Value
w1.Save
w1.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub
hatakontrol:
MsgBox Err.Description
Resume son
son:


End Sub

 

[kardelen79]

dosyayı açıp kapatırken bu uyarı çıkıyor her seferin de

 

[Tevfik_Kursun]

Merhaba,
Bu dosya başka bir dosyaya atıfta bulunuyor. Belki de başka bir dosyadan fonksiyonlu olan bir hücreyi kopyalayıp bu dosyaya yapıştırmışsınız.
/Dosya/Seçenekler bölümünde dosya bağlantılarını inceleyiniz.
İyi çalışmalar

 

[yasin85]

Merhaba,

Makro Günelleştirin diyin veya Excel makro bölümünden Makroya güvenli olduğunu tıklayınız.

 

[kardelen79]

BU şekilde 300 tane kitap var bu her kitap için dosya yollarını kayıt ve kapama fonksiyonlarını tek tek yazmam mı gerekin bu 300 tane kitap bir dosyanın içinde



Option Explicit

Sub dosyaac()
On Error GoTo hatakontrol
Dim Adese As Workbook
Dim BERA As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Adese = Workbooks.Open(ThisWorkbook.Path & "\BİROL OYAK\ADESE.xlsx")
Set BERA = Workbooks.Open(ThisWorkbook.Path & "\BİROL OYAK\BERA.xlsx")
'MsgBox Sheets(1).Range("a1").Value
Adese.Save
Adese.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub
hatakontrol:
MsgBox Err.Description
Resume son
son:


End Sub

 

[kardelen79]

Merhaba,
Bu dosya başka bir dosyaya atıfta bulunuyor. Belki de başka bir dosyadan fonksiyonlu olan bir hücreyi kopyalayıp bu dosyaya yapıştırmışsınız.
/Dosya/Seçenekler bölümünde dosya bağlantılarını inceleyiniz.
İyi çalışmalar

evet başka dosyaya burdan veri giditor ve geliyor

 

[Tevfik_Kursun]

Merhaba,
Siz 3. sıradaki ifadede söylediklerime ana dosya ve diğerlerinde bir - ikisine baktınız mı? (Demek ki yanlış bir dosyayı çağırıyor)
iyi çalışmalar

 

[kardelen79]

Bu şekilde 300 den fazla kitap var hepsinin yolunu gösterip save.ve close olarak yazmam mı gerekir



Option Explicit

Sub dosyaac()
On Error GoTo hatakontrol
Dim Adese As Workbook
Dim BERA As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Adese = Workbooks.Open(ThisWorkbook.Path & "\BİROL OYAK\ADESE.xlsx")
Set BERA = Workbooks.Open(ThisWorkbook.Path & "\BİROL OYAK\BERA.xlsx")
'MsgBox Sheets(1).Range("a1").Value
Adese.Save
Adese.Close
BERA.Save
BERA.Close


Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub
hatakontrol:
MsgBox Err.Description
Resume son
son:


End Sub

 

[Tevfik_Kursun]

Merhaba Arkadaşım,
Madem bu kadar önemli ve acil, makroyu koyacağınıza ana dosyanız ile öteki dosyalardan ikisini örnek olarak koysanıza mesajınıza. Buradaki yardım eden arkadaşları sihirbaz mı zannediyorsunuz?
İyi çalışmalar

 

[kardelen79]

yapmak istediğim fortföy yükleme yerinde renkli kısıma banka ekstrasını kopyalayı yapıştırıp ADESE çalışma kitabına verileri yollaması ADESE çalışma kitabı benzer 300 den fazla çalışma kitabı var o isim uyan çalışma kitabına verileri istediğim yere yüklemesi ve bunu yaparken 1 tuşa basıp hepsini aktarması bu şekilde 2 çalışma sayfası için yaptım çalışıyor ama 300 tane sayfa için ayrı ayrı dosya yolunu değişkenleri kopyala ve çalışma kitabını kapat formullerini tek tek yazmak zorundamıyım .veya bunu daha kolay yapabileceğim bir sistem olur mu

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kod bulunduğu klasördeki tüm excel dosyalarını açıp kaydedip kapatır.

Sub Test()
    Dim Dosya As Object
    Application.DisplayAlerts = False
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\BİROL OYAK" ).Files
        If Dosya.Type = "Microsoft Excel Çalışma Sayfası" And Not Dosya.Name = ThisWorkbook.Name Then
            Workbooks.Open(Dosya.Path).Close True
        End If
    Next
    Application.DisplayAlerts = True
End Sub

 

[kardelen79]

BİROL OYAK abi klosör adı bu buna yönlendirebilir misiniz kodu

 

[kardelen79]

Klasör adını Yanlış yere mi, yazdım olmadı


Sub Test()
Dim Dosya As Object
Application.DisplayAlerts = False
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files
If Dosya.Type = "BİROL OYAK" And Not Dosya.Name = ThisWorkbook.Name Then
Workbooks.Open(Dosya.Path).Close True
End If
Next
Application.DisplayAlerts = True
End Sub

 

[Muzaffer Ali]

11. mesajdaki kodu yeniledim.

 

[kardelen79]

 

[kardelen79]

Birde abi her açılan dosya için bu uyarı veriyor hepsine buna çare var mı

 

[kardelen79]

gelen veriler bu dosyalar için güvenilir

 

[Muzaffer Ali]

Uyarı çıkmaması için.
Menüden aşağıdaki pencereyi açın.
Üçünü de Etkinleştir olarak seçin.

 

[kardelen79]

 

[kardelen79]

abi bu şekilde miş ayarı zaten