Başka bir tablodan sütun ekleyip veri girme

[Galus]

Hocam,

Malesef ürün kod numaralarına göre ekleme yapmıyor. Daha önce yaptığınız makroda koda göre ekliyordu. Aynı kodu bulamazsa listenin altına ekliyordu. Ayrıca sütun eklemedinden veriyi hep aynı yere topluyor. Eski veriaktar makrosu süperdi.

Saygılar...

 

[Orion1]

Hocam,

Malesef ürün kod numaralarına göre ekleme yapmıyor. Daha önce yaptığınız makroda koda göre ekliyordu. Aynı kodu bulamazsa listenin altına ekliyordu. Ayrıca sütun eklemedinden veriyi hep aynı yere topluyor. Eski veriaktar makrosu süperdi.

Saygılar...

Bana yolladığınız dosyalardan ben kontrol ettim doğru kodlara ekliyor.Sütun ekleme durumu konusu ise bence sakıncalı.Şu sebepten bir sayfada 256 sütun var 255 kere veri girişi yaptıktan sonra program hata verecektir.

 

[Galus]

Hocam,

Problem değil. Her ay yeni bir stok kitabı olacak. Sonra veriler Zaten ayda en fazla 15/20 defa girilcek.

Teşekkürler..

 

[Orion1]

Program bende doğru kodlara ekleme yapıyordu.Benim yolladığım dosya üzerinde denedinizmi?Veya yanlış ekleme yaptığı dosyayı ekleyin bir göreyim .

 

[Galus]

Ürünlerin oraya herhangi ilgisiz bir şey yazılınca toplamıyor. Ekteki veriaktar da Galus yazdım onu bile topluyor. Bir farkla listede eşleştiremediğinden en alta ekliyor.Adeta kod yeni kod açıyor. Veriaktar makrosunu buraya uyarlasanız herşey süper olur.

Saygılar..

 

[Orion1]

Sayın Galus sanırım istediğiniz şekilde oldu.
Ekli dosyaları inceleyiniz.

Sub kitaba_Miktar_aktar()
Dim sayac As Byte
Workbooks("stok.xls").Activate
Sheets("giriş").Columns("E:E").Insert Shift:=xlToRight
For i = 2 To Workbooks("uretim.xls").Sheets("rapor").Cells(65536, "B").End(xlUp).Row
sayac = 0
    For k = 2 To Workbooks("stok.xls").Sheets("giriş").Cells(65536, "A").End(xlUp).Row
        If Workbooks("stok.xls").Sheets("giriş").Cells(k, "A").Value = Workbooks("uretim.xls").Sheets("rapor").Cells(i, "B").Value Then
            Workbooks("stok.xls").Sheets("giriş").Cells(k, "E").Value = Workbooks("uretim.xls").Sheets("rapor").Cells(i, "D").Value
            sayac = 1
            Exit For
        End If
    Next k
    If sayac = 0 Then
        sat = Sheets("giriş").Cells(65536, "A").End(xlUp).Row + 1
        Sheets("giriş").Cells(sat, "A").Value = Workbooks("uretim.xls").Sheets("rapor").Cells(i, "B").Value
        Sheets("giriş").Cells(sat, "B").Value = Workbooks("uretim.xls").Sheets("rapor").Cells(i, "C").Value
        Sheets("giriş").Cells(sat, "C").Formula = "=sum(D" & sat & ":IV" & sat & ")"
        Sheets("giriş").Cells(sat, "C").Font.Bold = True
        Sheets("giriş").Cells(sat, "D").Value = "="
        Sheets("giriş").Cells(sat, "E").Value = Workbooks("uretim.xls").Sheets("rapor").Cells(i, "D").Value
        sayac = 0
    End If
Next i
End Sub

 

[Galus]

Allah razı olsun hocam. Siz dostların hakkını nasıl ödeyeceğim bilemiyorum.
Teşekkürler..

 

[Galus]

Hocamdan Hammadeleri de halletmesini istemeğe yüzüm kalmadı.
Neylerse mevlam güzel eyler.

 

[Orion1]

Hocamdan Hammadeleri de halletmesini istemeğe yüzüm kalmadı.
Neylerse mevlam güzel eyler.

Onuda hallederiz.

 

[Galus]

Allah ne muradın varsa versin.

Amin...

 

[Orion1]

Allah ne muradın varsa versin.

Amin...

Amin.Cümlemizin.

 

[Orion1]

Merhaba.
İşlem tamamdır.
Hangi birimi aktarmak istiyosanız o nun üzerindeki butona tıklayınız.
Güle güle kullanın.

Sub kitaba_Hammade_aktar()
Dim sayac As Byte
Workbooks("stok.xls").Activate
Sheets("imalat").Columns("E:E").Insert Shift:=xlToRight
For i = 2 To Workbooks("uretim.xls").Sheets("rapor").Cells(65536, "G").End(xlUp).Row
sayac = 0
    For k = 2 To Workbooks("stok.xls").Sheets("imalat").Cells(65536, "A").End(xlUp).Row
        If Workbooks("stok.xls").Sheets("imalat").Cells(k, "A").Value = Workbooks("uretim.xls").Sheets("rapor").Cells(i, "G").Value Then
            Workbooks("stok.xls").Sheets("imalat").Cells(k, "E").Value = Workbooks("uretim.xls").Sheets("rapor").Cells(i, "I").Value
            sayac = 1
            Exit For
        End If
    Next k
    If sayac = 0 Then
        sat = Sheets("imalat").Cells(65536, "A").End(xlUp).Row + 1
        Sheets("imalat").Cells(sat, "A").Value = Workbooks("uretim.xls").Sheets("rapor").Cells(i, "G").Value
        Sheets("imalat").Cells(sat, "B").Value = Workbooks("uretim.xls").Sheets("rapor").Cells(i, "H").Value
        Sheets("imalat").Cells(sat, "C").Formula = "=sum(D" & sat & ":IV" & sat & ")"
        Sheets("imalat").Cells(sat, "C").Font.Bold = True
        Sheets("imalat").Cells(sat, "D").Value = "="
        Sheets("imalat").Cells(sat, "E").Value = Workbooks("uretim.xls").Sheets("rapor").Cells(i, "I").Value
        sayac = 0
    End If
Next i
End Sub

 

[Galus]

Eline sağlık, emeğine sonsuz teşekkürler...

Saygılarımla....

 

[Orion1]

Eline sağlık, emeğine sonsuz teşekkürler...

Saygılarımla....

Rica ederim.
Saygılar benden.

 

[Galus]

Hocam bunları tek düğme ile çalıştırmamız münkün mü?

Teşekkürler..

 

[Orion1]

Hocam bunları tek düğme ile çalıştırmamız münkün mü?

Teşekkürler..

Evet mümkün.
Şimdi ayarlarım.

 

[Orion1]

İşlem tamamdır.

 

[Galus]

Hocam sen ne iyi insansın ya. Artık teşekkür edecek söz bulamıyorum.
İfademi sadece saygı ve sevgilerimi arz etmekle yetindiğim için hoşgörünüze sığınıyorum...

 

[Orion1]

Hocam sen ne iyi insansın ya. Artık teşekkür edecek söz bulamıyorum.
İfademi sadece saygı ve sevgilerimi arz etmekle yetindiğim için hoşgörünüze sığınıyorum...

Estafurullah.
Yardımcı olabildiysek ne mutlu.
İyi akşamlar.

 

[Galus]

İyi akşamlar hocam...