ARA BUL VE RENLENDİRME

[umudaezgii]

Herkese merhaba ,
Ara bul ve renklendirme ile ilgili sitede birçok değerli çalışmayı inceledim. Fakat bizim yapmak istediğimizi açıkçası makro olarak beceremedik. Ara bul seçeneğinin birkaç işlem ile birleştirileceği bir makroya ihtiyacımız var. İnceleyebilirseniz memnun olurum.

2 sayfadan oluşan bir raporumuz var. İki sayfada da ortak olan veri ‘’ Senet Numarası’’ sütunudur.
İlk sayfadaki senet numaralarında tekrarlayan bilgi yoktur, 2. Sayfada konteyner numarası bilgilerinden dolayı senet numaraları aynı olan bilgiler mevcuttur.

Burada yapmak istediğimiz, ara bul ile arattığımız senet numaralarına ait tüm satırlar her 2 sayfada da renklenmeli, renklenen her 2 sayfadaki satırların tüm bilgileri Senetler(2) ve Satırlar(2) sayfalarındaki boş şablonlara kopyalamak istiyoruz ve ayrıca kopyalanan satırların ilk sayfalardan da silinmesi gerekmektedir.

Bu işlemleri kolaylaştırabilmek adına bir makro yapılabilir mi ? Yardımınızı rica ederim.

Teşekkürler

 

[ÖmerBey]

Merhaba,
Dosyanızın yedeğini aldıktan sonra aşağıdaki kodu deneyiniz

Sub kod()
Dim Sen As Worksheet, Sen2 As Worksheet, Sat As Worksheet, Sat2 As Worksheet
Dim satson As Long, senson As Long
Set Sen = Sheets("Senetler")
Set Sat = Sheets("Satırlar")
Set Sen2 = Sheets("Senetler (2)")
Set Sat2 = Sheets("Satırlar (2)")
1
senet = Application.InputBox("Senet numarası giriniz")
If senet = False Then
    Exit Sub
ElseIf WorksheetFunction.CountIf(Sen.Range("A:A"), senet) = 0 Then
    MsgBox "Senet numarası bulunamadı"
    GoTo 1
Else
    senson = Sen2.Cells(Rows.Count, "A").End(3).Row + 1
    Sen.Range("A:A").Find(senet, lookat:=xlWhole).EntireRow.Copy Sen2.Rows(senson)
    Sen.Range("A:A").Find(senet, lookat:=xlWhole).EntireRow.Delete
    Do While WorksheetFunction.CountIf(Sat.Range("A:A"), senet) > 0
        satson = Sat2.Cells(Rows.Count, "A").End(3).Row + 1
        Sat.Range("A:A").Find(senet, lookat:=xlWhole).EntireRow.Copy Sat2.Rows(satson)
        Sat.Range("A:A").Find(senet, lookat:=xlWhole).EntireRow.Delete
    Loop
    MsgBox senet & " numaralı senet taşındı."
    GoTo 1
End If
End Sub

 

[umudaezgii]

Ömer bey merhaba ,
Öncelikle desteğiniz için teşekkür ederim.
Kodu denediğimde olmadı, aşağıdaki uyarıyı alıyorum.

 

[umudaezgii]

Ömer bey merhaba ,

Sayfa koduna kopyaladığımda çalışıyor, tamda istediğimiz gibi olmuş, çok teşekkürler elinize sağlık .
Yalnız bu raporu sistemimizden çektiğimiz için her alışımızda, sayfaya kodu kopyalayarak mı çalışacağız ? Direk modüllerin içine kodu kopyaladığımızda çalışması için ne yapmamız gerekiyor ?

 

[ÖmerBey]

Merhaba,
Baştaki sayfa atama kısmını aşağıdaki şekilde değiştirirseniz aktif olan çalışma kitabında kodu kullanabilirsiniz. Belirgin bir çalışma kitabında kullanmak istiyoranız ilk satırı With Workbooks("DENEME.xlsx") şeklinde düzenleyebilirsiniz.

With ActiveWorkbook
    Set Sen = .Sheets("Senetler")
    Set Sat = .Sheets("Satırlar")
    Set Sen2 = .Sheets("Senetler (2)")
    Set Sat2 = .Sheets("Satırlar (2)")
End With

İyi çalışmalar...

 

[umudaezgii]

Ömer bey merhaba ,
Desteğiniz için çok teşekkürler. Sayenizde bir şeyler öğrenmeye de çalışıyoruz.
İyi çalışmalar ...

 

[ÖmerBey]

Rica ederim,
İyi çalışmalar...