Soru İrsaliye numarası yazınca diğer sayfadaki verileri şablon sayfasına ekleme

[link_me]

Merhabalar Şablon sayfasına İrsaliye numarası yazıp ekle diyince veri sayfasındaki ilgili verileri alıp şablon sayfasına kaydetmesini nasıl sağlayabilirim.
Ekle diyip alt alta verileri getirmesini temizle diyince tüm verileri temizlemek istiyorum.
Yardımcı olabilir misiniz?

 

[ÖmerFaruk]

Aşağıdaki kodları Module içine yerleştirerek butonlarınıza atayın.

Sub irsaliyebilgileri()
Dim Dizi, Bul As Range, x As Integer, i As Integer
    If Range("E" & Rows.Count).End(3).Row < 4 Then Exit Sub
    Dizi = Range("A4:E" & Range("E" & Rows.Count).End(3).Row).Value
    For x = 1 To UBound(Dizi)
        Set Bul = Worksheets("veri").Range("E:E").Find(Dizi(x, 5), , xlValues, xlWhole)
        If Not Bul Is Nothing Then
            For i = 1 To 5
            Dizi(x, i) = Bul.Offset(0, i - 5)
            Next i
        End If
    Next x
    Range("A4").Resize(UBound(Dizi), 5) = Dizi
    Set Bul = Nothing: Dizi = Empty: i = Empty: x = Empty
End Sub

Sub Temizle()
Range("A4:E" & Range("E" & Rows.Count).End(3).Row).ClearContents
End Sub

 

[link_me]

Şartım (F3) e İrsaliye numarasını yazmak istiyorum kodlardan hangisini değiştirmem gerekiyor acaba?

 

[ÖmerFaruk]

İrsaliyeleri tek tek mi çekeceksiniz?

Sub irsaliyebilgileri2()
Dim Bul As Range, i As Integer
    If [F3] = "" Then Exit Sub
    Set Bul = Worksheets("veri").Range("E:E").Find([F3], , xlValues, xlWhole)
    If Not Bul Is Nothing Then
        For i = 1 To 5
        Cells(Range("E" & Rows.Count).End(3).Row + 1, i) = Bul.Offset(0, i - 5)
        Next i
    End If
    Set Bul = Nothing: i = Empty:
End Sub

 

[link_me]

Sayın Ömer Faruk,

Tablomu biraz genişletmek istiyorum.
Verimi başka klasörden almak istiyorum Çalışma Kitabım burada \\10.17.0.2\Muhasebe\HAM MADDE\HMK\Excel-Atık Kağıt\2021 Klasörünün içindeki KDS-DÖKME (dosya şifreli 1234 ) sayfasında bulunuyor.

Set Bul kısmına yapıştırdım yapamadım.

birde ayrıca ekle dediğim zaman Ödenen diye sayfam var eklemiş olduğum verileri 3.sayfam buraya bu bilgilerin hepsini ekleme yapmak istiyorum.

Nasıl yapabilirim yardımcı olabilirseniz çok memnun kalırım.

 

[ÖmerFaruk]

Şifreyi kaldırın, dosyanızı paylaşın öyle bakayım

 

[link_me]

Örnek Dosyayı ektedir.

Yerli 2021 Klasöründen İrsaliyeleri Çekip Ekle dediğim
zaman ekleme yapınca Ödenen Kısmına da kopyala yapmasını istiyorum

 

[ÖmerFaruk]

İlk kez AĞda çalışacak bir ADO yaptım ancak evde AĞ olmadığından deneyemiyorum.
Aşağıdaki kodlarda ağdaki dosya ile ilgili
Yol - DosyaAdı - Sayfa Adı değişken olarak kodların ilk satırlarında verdim. Hatalı olanı düzeltirsiniz.

Sub irsaliyebilgileri2()
    Dim ifade As String, MyCn  As Object, MyRs As Object
    Dim Yol As String, Dosya As String, Sayfa As String, Aranan As String
    Yol = "\\10.17.0.2\Muhasebe\HAM MADDE\HMK\Excel-Atık Kağıt\2021\"
    Dosya = "2021 YERLİ.xlsx"
    Sayfa = "KDS-DÖKME"
    Aranan = Range("F3")
    Set MyCn = CreateObject("ADODB.Connection")
    Set MyRs = CreateObject("ADODB.recordset")
    MyCn.Provider = "Microsoft.ACE.OLEDB.12.0"
    MyCn.Properties("Data Source") = Yol & Dosya
    MyCn.Properties("Extended Properties") = "Excel 12.0; HDR=Yes"
    MyCn.Open
    ifade = "Select * from [" & Sayfa & "$] Where [İRSALİYE NUMARASI]= '" & Aranan & "'"
    MyRs.Open ifade, MyCn, 1, 1
    If MyRs.RecordCount > 0 Then
        Range("A" & Range("A" & Rows.Count).End(3).Row + 1).CopyFromRecordset MyRs
        Worksheets("Ödenen").Range("A" & Worksheets("Ödenen").Range("A" & Rows.Count).End(3).Row + 1).CopyFromRecordset MyRs
    End If
    MyRs.Close
    MyCn.Close
    Set MyCn = Nothing: Set MyRs = Nothing
End Sub

 

[link_me]

Sayın Ömer Faruk
Excel Çalışıyor Ağın içinden alabiliyorum.Çok Teşekkür ederim. Fakat Ödenen Kısmınada aynı anda kayıt yapmadı.İrsaliyeyi Çağırdımda Ödenen kısmınada kopyalama yapmadı.
Dosya şifreli olduğu zaman şifreyi nereye yazmam gerekiyor?

 

[ÖmerFaruk]

Dosya mı şifreli? Çalışma Sayfası mı?
İki satır alt alta. Birini yapıyorsa diğerini de yapmalı ya da hata vermeli.

Range("A" & Range("A" & Rows.Count).End(3).Row + 1).CopyFromRecordset MyRs
Worksheets("Ödenen").Range("A" & Worksheets("Ödenen").Range("A" & Rows.Count).End(3).Row + 1).CopyFromRecordset MyRs

 

[link_me]

Çalışma Sayfası şifreli
hiç bir hata da vermiyor .kopyalamıyorda

 

[ÖmerFaruk]

Şifrenizi aşağıdaki gibi kodların arasına giriniz

    If MyRs.RecordCount > 0 Then
        Range("A" & Range("A" & Rows.Count).End(3).Row + 1).CopyFromRecordset MyRs
        Worksheets("Ödenen").Unprotect "Şifreniz"
        Worksheets("Ödenen").Range("A" & Worksheets("Ödenen").Range("A" & Rows.Count).End(3).Row + 1).CopyFromRecordset MyRs
        Worksheets("Ödenen").Unprotect "Şifreniz"
    End If

 

[link_me]

Ömer Faruk Bey denemedim ama bir türlü yapamadım. irsaliye numarasına göre çok güzel bir şekilde geliyor bir türlü Ödenen sayfasına kayıt yapmıyor. kusura bakmayın başka bir yolu var mıdır?

Öğrenebilmek adına soruyorum Çalışma sayfası değilde Çalışma Kitabı şifreli olsaydı nasıl bir kod yazılması gerekirdi.

 

[ÖmerFaruk]

Bilgisayarımdaki hiç bir excel dosyası ya da çalışma sayafası şifreli değildir benim.
Bu sebeple bilemiyorum.

 

[link_me]

Sn Ömer Faruk ve site sakinleri,

dosya ile ilgili birkaç şey sormak istiyorum.

--Ekle butonuna bastığımda aynı irsaliye numarası mükerrer olunca hata vermesini nasıl sağlayabilirim.
--Eklediğim irsaliye numarasını Ödenen Sayfasına kopyalamasını nasıl sağlayabilirim.
--Temizle Butonuna tıkladığımda a4 e4 aralığındaki verileri silemiyorum. Birkaç kez temizle dediğimde Başlığı siliyor
-- Ekle butonuna birkaç kez bastığımda sayfa başlığının üzerine kaydediyor.

Bu konularda yardımcı olabilir misiniz?