Başka bir tablodan sütun ekleyip veri girme

[Galus]

Örnekte görüldüğü gibi Sayfa3 deki verileri Giriş sayfasına girmek istiyorum. Giriş sayfasında A sütununda ürünler bulunmakta. Ürünlerin toplamı B sütununda alındığından Sayfa3 den gelen veri önce Giriş sayfasına yeni bir C sütunu eklemeli ve A sütununda ürünün ait olduğu satır bulunmalı ve sonrada değeri eklenen C sütununa girmeli.

Teşekkürler..

 

[Orion1]

Merhaba.
Sayın Galus ekli dosyayı inceleyiniz.

Sub ekle()
Dim i As Long, sonsat As Long
Set s3 = Sheets("Sayfa3")
Set s1 = Sheets("Giris")
sonsat = s3.Cells(65536, "C").End(xlUp).Row
If sonsat < 7 Then GoTo son
s1.Columns("C:C").Insert Shift:=xlToRight
For i = 7 To sonsat
basla:
Set k = s1.Range("A2:A65536").Find(s3.Cells(i, "C").Value, LookIn:=xlValues, lookat:=xlWhole)
If k Is Nothing Then
    s1.Cells(s1.Cells(65536, "A").End(xlUp).Row + 1, "A").Value = s3.Cells(i, "C").Value
    GoTo basla
    Else
    s1.Cells(k.Row, "C").Value = s3.Cells(i, "D").Value
End If
Next
MsgBox "İşlem Tamamlanmıştır.", vbOKOnly + vbInformation
son:
Set s3 = Nothing
Set s1 = Nothing
End Sub

 

[Galus]

Sayın Orion2,

Çok çok teşekkürler..

 

[Orion1]

Sayın Orion2,

Çok çok teşekkürler..

Rica ederim.
İyi çalışmalar.:arkadas:

 

[Galus]

Hocam,

A sutununda ürün kodları olduğunu varsayarsak ürün toplamları C sütununda alınacak makro da eklemeyi D sütununa yapacak olursa ekteki tabloyu yeniden düzenlemenizi rica etmem münkün mü?

Teşekkürler..

 

[Orion1]

Merhaba.
Ürün kod numaralarına göre ekleme yapıyor.

Sub ekle()
Dim i As Long, sonsat As Long
Set s3 = Sheets("Sayfa3")
Set s1 = Sheets("Giris")
sonsat = s3.Cells(65536, "A").End(xlUp).Row
If sonsat < 2 Then GoTo son
s1.Columns("D:D").Insert Shift:=xlToRight
For i = 2 To sonsat
basla:
Set k = s1.Range("A2:A65536").Find(s3.Cells(i, "A").Value, LookIn:=xlValues, lookat:=xlWhole)
If k Is Nothing Then
    s1.Cells(s1.Cells(65536, "A").End(xlUp).Row + 1, "A").Value = s3.Cells(i, "A").Value
    GoTo basla
    Else
    s1.Cells(k.Row, "B").Value = s3.Cells(i, "B").Value
    s1.Cells(k.Row, "D").Value = s3.Cells(i, "C").Value
End If
Next
MsgBox "İşlem Tamamlanmıştır.", vbOKOnly + vbInformation
son:
Set s3 = Nothing
Set s1 = Nothing
End Sub

 

[Galus]

Hocam, Allah razı olsun. Çok çok teşekkürler..

 

[Orion1]

Hocam, Allah razı olsun. Çok çok teşekkürler..

Rica ederim.
İyi çalışmalar.

 

[Galus]

Bir problem var. Ürün toplamları C sütununda alınırken =TOPLA(D2:IV2) olan formül her sütun eklenişinde otamatik bir sonraki sütuna atıyor. Mesela örnekte görüldüğü üzere 4 kere deneme mahiyetinde veri girince formül =TOPLA(H2:IV2) oldu. Yani veri düzgün bir şekilde giriyor ama toplama işlemi bozuldu.

Selamlar..

 

[Galus]

Sütun girmesiyle bozulan toplama işlemini nasıl yaptırtabiliriz?

Teşekkürler..

 

[AS3434]

D sütununu boş bırakın. işlemi E sütunundan sonra yapın.

Sub ekle()
Dim i As Long, sonsat As Long
Set s3 = Sheets("Sayfa3")
Set s1 = Sheets("Giris")
sonsat = s3.Cells(65536, "A").End(xlUp).Row
If sonsat < 2 Then GoTo son
s1.Columns("[COLOR=red]E:E[/COLOR]").Insert Shift:=xlToRight
For i = 2 To sonsat
basla:
Set k = s1.Range("A2:A65536").Find(s3.Cells(i, "A").Value, LookIn:=xlValues, lookat:=xlWhole)
If k Is Nothing Then
    s1.Cells(s1.Cells(65536, "A").End(xlUp).Row + 1, "A").Value = s3.Cells(i, "A").Value
    GoTo basla
    Else
    s1.Cells(k.Row, "B").Value = s3.Cells(i, "B").Value
    s1.Cells(k.Row, "[COLOR=red]E[/COLOR]").Value = s3.Cells(i, "C").Value
End If
Next
MsgBox "İşlem Tamamlanmıştır.", vbOKOnly + vbInformation
son:
Set s3 = Nothing
Set s1 = Nothing
End Sub

 

[Galus]

Sayın AS3434,

Derdime derman oldunuz, Allah (CC) sizden razı olsun.

 

[AS3434]

Sayın Galus

Sizde sağolun. Ama ben birşey yapmadım, sadece Sayın Orion2 nin kodlarında minicik bir rötuş.
Sonradan farkettim, E1 hücresine Miktar yazısını yazmak için kodların alt kısmını şöyle düzenleyin.

[COLOR=navy].[/COLOR]
[COLOR=navy].[/COLOR]
[COLOR=navy]Next[/COLOR]
[COLOR=red]s1.[e1] = "MİKTAR"[/COLOR]
[COLOR=navy]MsgBox "İşlem Tamamlanmıştır.", vbOKOnly + vbInformation[/COLOR]
[COLOR=navy].[/COLOR]
[COLOR=navy].[/COLOR]

 

[Galus]

Hocam Allah (CC) emeği geçen herkesten razı olsun. Her ikinize de sonsuz teşekkürler..

 

[Orion1]

Sayın Galus
Sizde sağolun. Ama ben birşey yapmadım, sadece Sayın Orion2 nin kodlarında minicik bir rötuş.

Sayın AS3434 hocam ,gösterdiğiniz hassasiyetten dolayı size ayriyetten teşekkür ederim.İyi çalışmalar.Saygılar.

 

[Galus]

Sayın Orion hocam,

Veri aktar makrosunu ekteki "uretim.xls" kitapçığından "stok.xls" kitapçığına uyarlıyabilir miyiz? Uretim kitapçığı Rapor sayfaındaki ÜRÜN miktarları stok kitapçığının GİRİŞ sayfasına, HAMMADDE miktarları da imlat sayfasına gitmeli.

Teşekkürler..

 

[Orion1]

Sayın Orion hocam,

Veri aktar makrosunu ekteki "uretim.xls" kitapçığından "stok.xls" kitapçığına uyarlıyabilir miyiz? Uretim kitapçığı Rapor sayfaındaki ÜRÜN miktarları stok kitapçığının GİRİŞ sayfasına, HAMMADDE miktarları da imlat sayfasına gitmeli.

Teşekkürler..

Merhabalar.
Veri aktar makrosunu bulamadım.

 

[Galus]

Hocam,
Makroyu yapamadım. Habire debug diyip dediği için sizden yardım istemiştim.

 

[Orion1]

Merhaba.
Üretim dosyası ve Stok dosyası açık olmalı.
Şimdilik sadece sorunuzun birincisini yaptım.Üretim dosyasındaki butona basınız ve stok dosyasındaki giriş sayfasına bakınız.

Ekli dosyayı inceleyini.Eğer olduysa sorunuzun 2nci bölümünüde yapmaya başlayabilirim.

 

[Galus]

İşte bu hocam.. Eline emeğine sağlık. 2çbölümüde yaparsanız minnettarım.

Saygılar..