Ara Bul Aktar

[Hikmet26]

Merhabalar herkese iyi çalışmalar...

Dosyamda birçok sayfa bulunmakta bunlardan ikisi sabit Kapak ve Database diğer sayfalar ise müşteri isimleri... eklenebilir ve silinebilir...

Userform 3 te yanlızca bir adet combobox ve bir adet commandbutton bulunmakta

combobox1 de seçim yaptıktan sonra butona bastığımda kapak ve database sayfaları hariç kaç tane sayfa var ise combobox1 deki veriyi bütün sayfalarda arayıp bulacak ve verinin olduğu satırı kapak isimli sayfaya alt alta dizecek...

Aranan veri örneğin F-11 ise ve ben bu verinin bulunduğu satırın sonuna yapıldı diye not düştü isem bu veriyi almayacak. sadece sonunda yapıldı olmayan F-1 leri alt alta kapak sayfasına ekleyecek...

Dipnot: Kapak sayfasında daha önceden veri var ise bunların altına dizecek...

Yardımlarınız için şimdiden çok çok teşekkür ederim...

 

[Orion1]

Dosyanız ekte.

Dim sat As Long, k As Range, i As Integer
If ComboBox1.Value = "" Then
Sheets("Kapak").Select
MsgBox "Artical Numarası Seçmelisiniz...!", vbCritical
ComboBox2.SetFocus
Exit Sub
End If
sat = Sheets("Kapak").Cells(65536, "A").End(xlUp).Row + 1
For i = 1 To Worksheets.Count
    If Sheets(i).Name <> "Kapak" And Sheets(i).Name <> "DataBase" Then
        Set k = Nothing
        Set k = Sheets(i).Range("A2:A65536").Find(ComboBox1.Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
            Do
                If k.Offset(0, 6).Value <> "YAPILDI" Then
                    If sat >= 65534 Then
                        Sheets("Kapak").Select
                        Cells(sat, "A").Select
                        MsgBox "Kapak Sayfasında Satır Doldu !!" & vbLf & _
                        "Başka kayıt yapamazsınız..!!", vbCritical, "UYARI"
                    Exit Sub
                    End If
                    Sheets("Kapak").Range(Sheets("Kapak").Cells(sat, "A"), _
                    Sheets("Kapak").Cells(sat, "F")).Value = _
                    Sheets(i).Range(Sheets(i).Cells(k.Row, "A"), Sheets(i).Cells(k.Row, "F")).Value
                    sat = sat + 1
                End If
                Set k = Sheets(i).Range("A2:A65536").FindNext(k)
            Loop While adr <> k.Address And Not k Is Nothing
        End If
    End If
Next i

 

[Hikmet26]

Evren GİZLEN kardeşim ellerin aklın kafan dert görmesin çok çok Teşekkür ediyorum... Sağolasın...

 

[Orion1]

Evren GİZLEN kardeşim ellerin aklın kafan dert görmesin çok çok Teşekkür ediyorum... Sağolasın...

Rica ederim.
Sizde sağolun.