• Merhaba Ziyaretçi,
    Microsoft 365 Uygulamaları ile ilgili yeni haberler, dikkat çekici konular, ilgi ile takip edeceğiniz yazılar için.

    Abone Olun
  • ESTE - Microsoft Office Eğitimleri

    Yeni yıl Microsoft Office Eğitim planlarınız için bütçenizi oluşturmadan önce ESTE eğitim kalitesi ile tanışın. 🙌
    Kullanıcıların ihtiyacı olan yazılı materyal, dosya ve video kaynağı desteğimiz ile tüm ofis çalışanlarının iş süreçlerini rahatlatacak eğitimler planlayın. 🎯
    Microsoft Office eğitimlerimiz hakkında detaylı bilgi için bize ulaşın.

    👉 Microsoft Office Eğitim Talebi

Yardım Kapalı Excel Kitaplarından Ado ile Şartlı Veri Güncelleme Hk.

Valentino06

Yeni Üye
Katılım
9 Nis 2019
Mesajlar
16
En iyi yanıt
0
Puanları
3
Konum
Ankara
Ad Soyad
Muharrem Esen
Office Vers.
2019 türkçe
Merhaba,
Hocalarım. gerekli açıklamayı kitap içinde yaptım. kısacası Veri al ile çekmiş olduğum verileri Ado ile "C"Sütunu şart baz alınarak verileri sürekli güncellemek istiyorum. aşağıdaki kriterlere göre Book1 de "P4,Q4,S4,T4" Data kitabında " F4,H4,J4,L4" Getirmek istiyorum güncel hallerini lütfen yardımcı olabilirmisiniz.çok teşekkür ederim.
Not. Klasör içinde 1 den fazla kitap olacak belki sayı 100- 200 kitap bu kitaplardaki verileri yukardaki data kitabına çekmek istiyorum.
 

Ekli dosyalar

  • Örnek (1).rar
    196.1 KB · Görüntüleme: 9

Murat OSMA

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,506
En iyi yanıt
13
Puanları
113
Konum
İstanbul
Web sitesi
excelarsivi.com
Ad Soyad
Murat OSMA
Office Vers.
Office 365 TR+EN
Merhaba,
Kodları bu şekilde revize edip deneyin... (y)
PHP:
Sub ImportDataFromMultipleWorkbooks()
    Dim vaFiles As Variant, wbkToCopy As Workbook, ws As Worksheet, wsa As Worksheet, osma As Range
    ThisWorkbook.Activate
    Set ws = Sheet2
    un = "Dear " & Environ("UserName")
    ms1 = MsgBox("Do You Want to Import Data from Multiple Workbooks", vbInformation + vbYesNo, un)
    If ms1 = vbYes Then
        'Intersect(ws.Range("4:175"), ws.Range("C:E,F:F,H:H,J:J,L:L,O:O,R:R")).ClearContents
        ChDir (ThisWorkbook.Path)
        vaFiles = Application.GetOpenFilename( _
                  FileFilter:="Microsoft Excel Workbooks(*.xls;*.xlsx;*.xlsb;*.xlsm),*.xls;*.xls;*.xlsx;*.xlsb;*.xlsm", _
                  Title:="Select Files to Proceed", MultiSelect:=True)
        With Application
            .DisplayAlerts = False
            .ScreenUpdating = False
        End With
        say = ws.Cells(175, 3).End(3).Row + 1
        If say < 4 Then say = 4
        If IsArray(vaFiles) Then
            For i = LBound(vaFiles) To UBound(vaFiles)
                If vaFiles(i) = ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name Then
                    ms4 = MsgBox("Cannot Open Itself", vbExclamation, un)
                    GoTo skipfile:
                End If
                Set wbkToCopy = Workbooks.Open(Filename:=vaFiles(i))
                Set wsa = ActiveWorkbook.ActiveSheet
                
                Set osma = ThisWorkbook.Worksheets(1).Columns(3).Find(wsa.Range("B2").Value, , , 1)
                If Not osma Is Nothing Then
                    ws.Cells(osma.Row, "C") = wsa.Range("B2")
                    ws.Cells(osma.Row, "D") = wsa.Range("B1")
                    ws.Cells(osma.Row, "E") = wsa.Range("B5")
                    ws.Cells(osma.Row, "F") = wsa.Range("P4")
                    ws.Cells(osma.Row, "H") = wsa.Range("Q4")
                    ws.Cells(osma.Row, "J") = wsa.Range("S4")
                    ws.Cells(osma.Row, "L") = wsa.Range("T4")
                    ws.Cells(osma.Row, "O") = wsa.Range("B3")
                    ws.Cells(osma.Row, "R") = wsa.Range("B4")
                    wbkToCopy.Close savechanges:=False
                        Else
                    ws.Cells(say, "C") = wsa.Range("B2")
                    ws.Cells(say, "D") = wsa.Range("B1")
                    ws.Cells(say, "E") = wsa.Range("B5")
                    ws.Cells(say, "F") = wsa.Range("P4")
                    ws.Cells(say, "H") = wsa.Range("Q4")
                    ws.Cells(say, "J") = wsa.Range("S4")
                    ws.Cells(say, "L") = wsa.Range("T4")
                    ws.Cells(say, "O") = wsa.Range("B3")
                    ws.Cells(say, "R") = wsa.Range("B4")
                    wbkToCopy.Close savechanges:=False
                    say = say + 1
                End If
skipfile:
            Next i
            ms5 = MsgBox("Data Import Finished", vbInformation, un)
        Else
            ms3 = MsgBox("No Files Selected", vbExclamation, un)
        End If
    Else
        ms2 = MsgBox("Cancelled", vbInformation, un)
    End If
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub
 

Valentino06

Yeni Üye
Katılım
9 Nis 2019
Mesajlar
16
En iyi yanıt
0
Puanları
3
Konum
Ankara
Ad Soyad
Muharrem Esen
Office Vers.
2019 türkçe
Merhaba,
Murat Bey çok teşekkür ederim. ellerinize sağlık çok güzel çalışıyor. kusura bakmayın dışarı çıkmıştım. yeni gördüm. hocam alt topları üste aldım. birde sütun ekleyince kayma oldu. "R" Sütünü "S" Sütunu olarak değiştirebilirmiyiz. ben denedim nerde hatta yaptım anlamadım. hata verdi eklenen sütünları data kitabında sarı ile boyadım. Murat Hocam son bir istek klasör içindeki kitapları daha doğrusu değişiklik yapılanları örnek veriyorum. bugün 20 kitaba güncelleme yaptım. 20 sini birden toplu bir şekilde yapılan güncellemeleri aktarma şanşımız varmı lütfen yardımcı olabilirmisiniz. çok teşekkür ederim.
 

Ekli dosyalar

  • Örnek (1).rar
    313.4 KB · Görüntüleme: 1

Valentino06

Yeni Üye
Katılım
9 Nis 2019
Mesajlar
16
En iyi yanıt
0
Puanları
3
Konum
Ankara
Ad Soyad
Muharrem Esen
Office Vers.
2019 türkçe
Merhaba,
Murat Hocam "S"Sütununa getiriyorum verileri şöyle bir hata alıyorum çektiğim zaman veriyi üzerine güncellemiyor. alta atıyor. o zaman da mükerrer oluyor. lütfen yarımcı olabilirmisiniz. klasör içindeki kitaplara vba ile üzerine çift tıklandığında veriyi açtırabilirmiyiz. bir butonlada verileri kaydet yapılabilirmi.kaydet me zamanı bilmek için verilerin güncelliğini takip edebilme adına böyle birşey istiyoruz. Allah kat kat razı olsun. çok teşekkür ederim.
 

Valentino06

Yeni Üye
Katılım
9 Nis 2019
Mesajlar
16
En iyi yanıt
0
Puanları
3
Konum
Ankara
Ad Soyad
Muharrem Esen
Office Vers.
2019 türkçe
Özür dilerim yanlış anlatmışım data kitabında "C"sutundaki herhangi hücre içeriğine çift tıkladığımda klasörler içindeki tıklamış olduğum değeri bulsun ve açsın. İnşallah yapılabilir.
 

Murat OSMA

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,506
En iyi yanıt
13
Puanları
113
Konum
İstanbul
Web sitesi
excelarsivi.com
Ad Soyad
Murat OSMA
Office Vers.
Office 365 TR+EN
Kullandığınız son gerçek dosyalarınızı yollarsanız bir bakalım.
 

Valentino06

Yeni Üye
Katılım
9 Nis 2019
Mesajlar
16
En iyi yanıt
0
Puanları
3
Konum
Ankara
Ad Soyad
Muharrem Esen
Office Vers.
2019 türkçe
Merhaba,
Günaydın Murat Hocam orjinal kitabın bire bir aynısını ekliyorum.Murat Hocam Kayıt olayını işten çıkmmadan önce son hali ile günceleyip o günün tarihini vererek başka bir klasörde gün gün tutmak istiyorum. ve size yazmış olduğum diğer bilgileri yapmak istiyorum. Hocam çok teşekkür ederim.
 

Ekli dosyalar

  • Örnek.rar
    430.4 KB · Görüntüleme: 4

Valentino06

Yeni Üye
Katılım
9 Nis 2019
Mesajlar
16
En iyi yanıt
0
Puanları
3
Konum
Ankara
Ad Soyad
Muharrem Esen
Office Vers.
2019 türkçe
Merhaba,
Murat Hocam İnşallah bizi unutmamışsınızdır. çok teşekkür ederim.
 

Valentino06

Yeni Üye
Katılım
9 Nis 2019
Mesajlar
16
En iyi yanıt
0
Puanları
3
Konum
Ankara
Ad Soyad
Muharrem Esen
Office Vers.
2019 türkçe
Günaydın Arkadaşlar Hayırlı İşler
 

Valentino06

Yeni Üye
Katılım
9 Nis 2019
Mesajlar
16
En iyi yanıt
0
Puanları
3
Konum
Ankara
Ad Soyad
Muharrem Esen
Office Vers.
2019 türkçe
Merhaba Murat Hocam Hayırlı geceler hocam bir çözümü varmı?
 
Üst Alt