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

Katılım
9 Nis 2019
Mesajlar
8
En İyi Yanıtlar
0
Beğeniler
0
Puanları
1
Yaş
45
Konum
Muhasebe
Ad Soyad
Muharrem Esen
#1
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

Admin

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,054
En İyi Yanıtlar
77
Beğeniler
855
Puanları
113
Konum
İstanbul
#2
Merhaba,
Kodları bu şekilde revize edip deneyin... (y)
VBA:
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
 
Katılım
9 Nis 2019
Mesajlar
8
En İyi Yanıtlar
0
Beğeniler
0
Puanları
1
Yaş
45
Konum
Muhasebe
Ad Soyad
Muharrem Esen
#3
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

Katılım
9 Nis 2019
Mesajlar
8
En İyi Yanıtlar
0
Beğeniler
0
Puanları
1
Yaş
45
Konum
Muhasebe
Ad Soyad
Muharrem Esen
#4
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.
 
Katılım
9 Nis 2019
Mesajlar
8
En İyi Yanıtlar
0
Beğeniler
0
Puanları
1
Yaş
45
Konum
Muhasebe
Ad Soyad
Muharrem Esen
#5
Ö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.
 

Admin

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,054
En İyi Yanıtlar
77
Beğeniler
855
Puanları
113
Konum
İstanbul
#6
Kullandığınız son gerçek dosyalarınızı yollarsanız bir bakalım.
 
Katılım
9 Nis 2019
Mesajlar
8
En İyi Yanıtlar
0
Beğeniler
0
Puanları
1
Yaş
45
Konum
Muhasebe
Ad Soyad
Muharrem Esen
#7
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

Katılım
9 Nis 2019
Mesajlar
8
En İyi Yanıtlar
0
Beğeniler
0
Puanları
1
Yaş
45
Konum
Muhasebe
Ad Soyad
Muharrem Esen
#8
Merhaba,
Murat Hocam İnşallah bizi unutmamışsınızdır. çok teşekkür ederim.
 
Üst Alt