Aradıgını bulamayınca Macro yu kesiyor

[Armani]

Günaydın arkadaşlar.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Sheets("Konserve").[2:65536].Delete
Workbooks.Open Filename:="t:\audit\Ankara.xls"
Workbooks("Ankara.XLS").Activate
Sheets("Ankara").Select
Sheets("Ankara").[a2:r65536].Sort Key1:=Sheets("Ankara").[G2]
ilksat = Sheets("Ankara").[G1:G65536].Find(26).Row
sonsat = WorksheetFunction.CountIf(Sheets("Ankara").[G1:G65536], 26) + ilksat - 1
Sheets("Ankara").Rows(ilksat & ":" & sonsat).Copy
Workbooks("New_Sablon.xls").Activate
Sheets("Konserve").Rows(2).PasteSpecial Paste:=xlAll

Workbooks("Ankara.XLS").Activate
Sheets("Ankara").Select
ilksat1 = Sheets("Ankara").[G1:G65536].Find(27).Row
sonsat1 = WorksheetFunction.CountIf(Sheets("Ankara").[G1:G65536], 27) + ilksat1 - 1
Sheets("Ankara").Rows(ilksat1 & ":" & sonsat1).Copy
Workbooks("New_Sablon.xls").Activate
sondakisatir = Sheets("Konserve").[a65536].End(xlUp).Row 'sondaki satırı bulur
Sheets("Konserve").Cells(sondakisatir + 1, "a").PasteSpecial Paste:=xlAll
Application.CutCopyMode = False

Yukarıdaki kod da görülecegi gibi "g" sütununda 26 ve 27 yazanları dikkate alıp kopyalama yapıyor. Şu an mesela 26 yı bulamaz ise excelden çıkıyor. Sizden ricam bulamadıgı zaman çıkmasın 27 yazanları kopyalasın

ilginiz için şimdiden teşekkür ederim.

iyi çalışmalar

 

[Korhan Ayhan]

Selamlar,

Örnek bir dosya ekleyebilirmisiniz.

 

[Armani]

örnek dosya ekdedir.

 

[Korhan Ayhan]

Selamlar,

Aktarmak istediğiniz kayıtlar örneğin 26 kod nolu kayıtlar "ankara" isimli sayfada hep alt altamı devam ediyor yoksa aralarda farklı kodlar oluyormu?

 

[Armani]

Hep alt alta devam ediyor.. sırayla gidiyor. ankara.xls dosyasında bl 26 hiç girilmemişse kesiliyor. halbuki istedigim 26 yı bulamasa bile 27 için devam etmesi

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki hesaplamalar hangi sütunda hangi işlemi yapıyor açıklarmısınız.

Okutulan Artikel Sayısı = ? (Aktarılan veri sayısımı?)

Teorik 0-5 Sayısı = ? (Hangi sütunda neyi sayıyor?)

Mevcudu 0 olan = ? (Hangi sütunda neyi sayıyor?)

Mevcudu 0 dan az = ? (Hangi sütunda neyi sayıyor?)

 

[Armani]

Teorik 0-5, Mevcudu 0 ,Mevcudu 0 dan az hepsi m sütunundan yani stok sütunundan alıyor.. ama bu kısım hesaplama kısmı..benim istedigm sadece bir bölümde 2 kısım var. (26 ve 27) bunlardan birisi olmayınca kesiliyor...deneyebilirsiniz. bölüm numarası 26 veya 27 olanı silin çalıştırın ...hata verdigini göreceksiniz

teşekkürler ilginize

 

[Korhan Ayhan]

Selamlar,

Sizin çalışmanız üzerinde biraz değişklik yaptım fakat öğleden sonra sizden cevap alamayınca son sorumu netleştirmeden eklemek istemedim cevabımı yarın işyerinden eklerim. (Çünkü orda kaldı.) :hey:

 

[Korhan Ayhan]

Selamlar,

Sadece bir buton için kod veriyorum. Eğer sizin için uygunsa diğerlerinede uygularsınız. İşlemin yarıda kesimemesi için döngü kullanarak aktarma işlemini yaptım. Umarım işinize yarar.

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Sheets("Konserve").[2:65536].Delete
    Workbooks.Open Filename:="C:\Audit\Ankara.xls"
    Workbooks("Ankara.XLS").Activate
    Sheets("Ankara").Select
    Sheets("Ankara").[A2:R65536].Sort Key1:=Sheets("Ankara").[G2]
    
    VeriSay1 = WorksheetFunction.CountIf(Sheets("Ankara").[G1:G65536], 26)
    VeriSay2 = WorksheetFunction.CountIf(Sheets("Ankara").[G1:G65536], 27)
    ToplamVeri = VeriSay1 + VeriSay2
    
    For X = 2 To Sheets("Ankara").[A65536].End(3).Row
    If ToplamVeri = 0 Then GoTo İşlemi_Sonlandır
    If Sheets("Ankara").Cells(X, "G").Value = 26 Or Sheets("Ankara").Cells(X, "G").Value = 27 Then
    Sheets("Ankara").Rows(X).Copy
    Workbooks("New_Sablon.xls").Activate
    Sheets("Konserve").Select
    Son = Sheets("Konserve").[A65536].End(3).Row + 1
    Sheets("Konserve").Cells(Son, 1).PasteSpecial Paste:=xlAll
    Sheets("Konserve").[A1].Select
    Workbooks("Ankara.XLS").Activate
    Sheets("Ankara").Select
    Application.CutCopyMode = False
    End If
    Next
    Workbooks("New_Sablon.xls").Activate
    
'Okutulan Toplam Artikel Sayısı hesaplanması
    Say = 0
    SonSatır = Sheets("Konserve").Cells(65536, "F").End(3).Row
    Sheets("Konserve").Cells(SonSatır + 3, "F").Value = "Okutulan Artikel Sayısı"
    Sheets("Konserve").Cells(SonSatır + 3, "G").Value = ("=")
    
    For K = 2 To SonSatır
    If Sheets("Konserve").Cells(K, "G").Value < 1 Then Say = Say + 1
    If Sheets("Konserve").Cells(K, "G").Value > 0 Then Say = Say + 1
    Next
    Sheets("Konserve").Cells(SonSatır + 3, "H").Value = Say
    
'Mevcudu 1 den az olam artikel sayisinin hesaplanmasi
    Say = 0
    Say1 = 0
    Say2 = 0
    Say3 = 0
    Sheets("Konserve").Cells(SonSatır + 4, "F").Value = "Teorik 0-5 Sayısı"
    Sheets("Konserve").Cells(SonSatır + 4, "G").Value = "="
    
    For K = 2 To SonSatır
    If Sheets("Konserve").Cells(K, "J").Value = 1 Then Say = Say + 1
    If Sheets("Konserve").Cells(K, "J").Value = 2 Then Say = Say + 1
    If Sheets("Konserve").Cells(K, "J").Value = 3 Then Say = Say + 1
    If Sheets("Konserve").Cells(K, "J").Value = 4 Then Say = Say + 1
    Next
    Sheets("Konserve").Cells(SonSatır + 4, "H").Value = Say + Say1 + Say2 + Say3
    
'Gap Rate'in hesaplamasi
    Say = 0
    Sheets("Konserve").Cells(SonSatır + 5, "F").Value = "Mevcudu 0 Olanlar"
    Sheets("Konserve").Cells(SonSatır + 5, "G").Value = ("=")
    
    For K = 2 To SonSatır
    If Sheets("Konserve").Cells(K, "J").Value = 0 Then Say = Say + 1
    Next
    Sheets("Konserve").Cells(SonSatır + 5, "H").Value = Say
    
'Mevcudu 0 dan az olanlar
    Say = 0
    Sheets("Konserve").Cells(SonSatır + 6, "F").Value = "Mevcudu 0'dan Az Olanlar"
    Sheets("Konserve").Cells(SonSatır + 6, "G").Value = "="
    
    For K = 2 To SonSatır
    If Sheets("Konserve").Cells(K, "J").Value < 0 Then Say = Say + 1
    Next
    Sheets("Konserve").Cells(SonSatır + 6, "H").Value = Say

'*****************************************************************
'SAYFA DÜZENİ
    
    Application.CutCopyMode = False
    Workbooks("Ankara.XLS").Activate
    Workbooks("Ankara.XLS").Save
    Workbooks("Ankara.XLS").Close
    Workbooks("New_Sablon.xls").Activate
    Sheets("Konserve").Cells.EntireColumn.AutoFit
    ThisWorkbook.Save
    Adet = Sheets("Konserve").Cells(SonSatır + 3, "H").Value
    MsgBox "BU ÜRÜN GRUBUNDA " & Adet & " KAYIT BULUNMUŞTUR." _
    & Chr(13) & Chr(13) & "AKTARIM İŞLEMİ TAMAMLANMIŞTIR.", vbInformation
    Application.ScreenUpdating = True
    Exit Sub
    
İşlemi_Sonlandır:
    Workbooks("Ankara.XLS").Activate
    Workbooks("Ankara.XLS").Save
    Workbooks("Ankara.XLS").Close
    Workbooks("New_Sablon.xls").Activate
    MsgBox "UYGUN KAYIT BULUNAMADI.", vbExclamation, "DİKKAT !"
End Sub

 

[Armani]

çok teşekkürler arkadaşım...bu istedigimden fazlası olmuş. ellerine sağlık.. en güzel ve başarılı günlre sizinle olsun..

iyi çalışmalar