sayfaları birleştirme

[yesilcan]

Değerli arkadaşlar ekdeki dosyamda dilimin döndüğünce sıkıntımı anlatmaya çalıştım.
yardımlarınız bekliyor
herkese iyi çalışmalar diliyorum.
Saygılarımla
Serdar

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.


Kullanılan kod; (Boş bir modüle uygulayınız.)

Option Explicit
 
Sub ARA()
    Dim X As Byte, SAYFA As Worksheet, BUL As Range
    Sheets("anasayfa").Select
    If [B1] = "" Then
    MsgBox "Lütfen aramak istediğiniz stok numarasını giriniz !", vbExclamation, "Dikkat !"
    [B1].Select
    Exit Sub: End If
 
    [B2] = Empty
 
    For Each SAYFA In Worksheets
        If SAYFA.Name <> "anasayfa" And SAYFA.Name <> "birleştir" Then
        Set BUL = SAYFA.Range("A:A").Find([B1], LookAt:=xlWhole)
        If Not BUL Is Nothing Then
        [B2] = SAYFA.Name
        [B3] = SAYFA.Cells(BUL.Row, "C")
        MsgBox "Aradığınız stok bulunmuştur.", vbInformation
        Exit For
        End If
        End If
    Next
 
    If [B2] = Empty Then
    MsgBox "Aradığınız stok bulunamamıştır.", vbCritical
    End If
End Sub
 
Sub GİT()
    Sheets("anasayfa").Select
    If [B11] = "" Then
    MsgBox "Lütfen gitmek istediğiniz sayfa adını giriniz !", vbExclamation, "Dikkat !"
    [B11].Select
    Exit Sub: End If
 
    On Error GoTo Hata
    Sheets([B11].Text).Select
    Exit Sub
Hata:
[B11].Select
MsgBox "Gitmek istediğiniz sayfa bulunamamıştır !" & vbCrLf & "Lütfen yazdığınız sayfa adını kontrol ediniz !", vbExclamation, "Dikkat !"
End Sub
 
Sub BİRLEŞTİR()
    Dim X As Byte, SAYFA As Worksheet, Satır As Long
    Sheets("birleştir").Select
 
    [A2:C65536].ClearContents
 
    For Each SAYFA In Worksheets
        If SAYFA.Name <> "anasayfa" And SAYFA.Name <> "birleştir" Then
        Satır = SAYFA.Range("A65536").End(3).Row
        If Satır > 1 Then
        SAYFA.Range("A2:C" & Satır).Copy Range("A65536").End(3).Offset(1)
        End If
        End If
    Next
 
    If [A2] = Empty Then
    MsgBox "Birleştirilecek veri bulunamamıştır", vbCritical
    Else
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
End Sub

Aşağıdaki kodu ThisWorkbook bölümüne uyglayın.

Option Explicit
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim SAYFA As Worksheet, SAY As Integer, BUL As Range
    If Intersect(Target, [A2:A65536]) Is Nothing Then Exit Sub
    On Error GoTo Son
    If Target <> "" Then
    For Each SAYFA In Worksheets
        If SAYFA.Name <> "anasayfa" And SAYFA.Name <> "birleştir" Then
        SAY = SAY + WorksheetFunction.CountIf(SAYFA.Range("A:A"), Target)
        Set BUL = SAYFA.Range("A:A").Find(Target, , , xlWhole)
        If SAY > 1 Then GoTo Devam
        End If
    Next
    GoTo Son
Devam:
        MsgBox "Girdiğiniz stok kodu daha önce aşağıdaki sayfada girilmiştir !" & vbCrLf & _
        "Lütfen kontrol ediniz !" & vbCrLf & vbCrLf & "Sayfa adı ; " & SAYFA.Name & vbCrLf & "Satır no   ; " & BUL.Row, vbCritical, "Mükerrer Kayıt !"
        Target.Select
        Target = Empty
        Set BUL = Nothing
    End If
Son:
End Sub

 

[ersoyalan]

Merhaba,

Korhan hocam cevabı tam olarak vermiş fakat bende birşeyler yapıyordum.Korhan hocamın kodlarından ekleme yaparak işlemi bitirdim.Biraz daha farklı bir çözüm isterseniz kullanabilirsiniz.

E.ALAN

 

[yesilcan]

ilgi ve alakanız için sonsuz teşekkürler.son isteğim daha olacak affınıza sığınarak ;

anasayfa sheetindeki "bulunan sayfa 'nın" altına bulunan adedide ekleyebilirseniz süper olacak.
kolay gelsin.

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki dosyayı ve kodu güncelledim. İncelermisiniz.

 

[yesilcan]

süper süper süper..
çok teşekkür ederim

 

[yesilcan]

Karşılaştığım bir hatayı söylemek istiyorum
sayfa adları değiştiğinde yada yeni sayfa eklendiğinde kodlar çalılmıyor

 

[Korhan Ayhan]

Selamlar,

Sn. yesilcan,

Kodlar örnek dosyanıza göre hazırlandı. Eğer sayfa adları değişken olacak diye belirtseydiniz çözümüde o yönde alacaktınız. Belirtmediğiniz sürece bizler sizlerin nasıl çözüm aradığınızı sadece tahmin edebiliyoruz.

 

[yesilcan]

çok özür dilerim.bundan sonraki sorularımı bu yönde soracığımdan emin olabilirsiniz.
sonuç olarak bu sıkıntıda yardımcı olabilirmisiniz?

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki dosyayı ve kodu güncelledim. İncelermisiniz.

 

[yesilcan]

çok değerli arkadaşlar.konuyla ilgili bir isteğim daha olacak.hatayı önlemek açısında bir sayfada yazılan stok numarası diğer sayfalarda varsa(bulunan sayfayı gösterirse daha iyi olacağını düşünüyorum) uyarı veren bir kod oluşturabilirmiyiz.?
yani mükerrer yazılımı önlemek açısından önem taşıyor.
Saygılarımla
Serdar.

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki dosyayı ve kodu güncelledim. İncelermisiniz.

 

[yesilcan]

Korhan bey çok teşekkür ederim emeğinize sağlık