Aralara otomatik veri girme

[asubsubaru]

ustalar yardımlarınızı bekliyorum açıklama eklediğim dosyada

 

[Levent Menteşoğlu]

Aşağıdaki kodu dosyanızda deneyin.

Sub arayaekle()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
For a = 1 To s2.[b65536].End(3).Row
If s2.Cells(a, "a") <> "" Then
deger = s2.Cells(a, "a")
c = c + 1
End If
ilk = WorksheetFunction.Match(deger, s1.[a:a], 0)
son = WorksheetFunction.CountIf(s1.[a:a], deger) + ilk
s1.Rows(son).Insert Shift:=xlDown
s1.Cells(son, "b").NumberFormat = s2.Cells(a, "b").NumberFormat
s1.Cells(son, "b") = s2.Cells(a, "b")
If c = 1 Then
s1.Cells(son, "a") = deger
c = 0
End If
Next
End Sub

 

[asubsubaru]

yardımın için çok saol fakat şöyle bi sorunum var bu kopyalama işlemini özel kopyala yapabilirmiyiz sadece değerleri ve sayı biçimleri olacak şekilde gönderebilirmiyiz aktarılan hücrelerde saat formül vb değerler olduğu için aktarımdan sonra değrler değişiyor

 

[Levent Menteşoğlu]

Üstteki mesajımda bulunan kodu yeniledim. Bu haliyle deneyin.

 

[asubsubaru]

Sub arayaekle()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
For a = 1 To s2.[b65536].End(3).Row
If s2.Cells(a, "a") <> "" Then
deger = s2.Cells(a, "a")
c = c + 1
End If
ilk = WorksheetFunction.Match(deger, s1.[a:a], 0)
son = WorksheetFunction.CountIf(s1.[a:a], deger) + ilk
s1.Rows(son).Insert Shift:=xlDown
s1.Cells(son, "d").NumberFormat = s2.Cells(a, "d").NumberFormat
s1.Cells(son, "d") = s2.Cells(a, "d")
s1.Cells(son, "e").NumberFormat = s2.Cells(a, "e").NumberFormat
s1.Cells(son, "e") = s2.Cells(a, "e")
If c = 1 Then
s1.Cells(son, "a") = deger
c = 0
End If
Next
End Sub


bu kodu kullanıyorum aktarınan değerler den biri yer değiştiriyor neden olabilir bi bakabilirmisiniz

satır1- satır2- satır3- satır4 diye gitmesi gerekirken
satır1- satır4- satır2- satır3 olarak gidiyor

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Sub arayaekle()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
For a = 1 To s2.[b65536].End(3).Row
If s2.Cells(a, "a") <> "" Then
c = c + 1
son = 0
deger = s2.Cells(a, "a")
ilk = WorksheetFunction.Match(deger, s1.[a:a], 0)
son = WorksheetFunction.CountIf(s1.[a:a], deger) + ilk
End If
s1.Rows(son).Insert Shift:=xlDown
s1.Cells(son, "d").NumberFormat = s2.Cells(a, "d").NumberFormat
s1.Cells(son, "d") = s2.Cells(a, "d")
s1.Cells(son, "e").NumberFormat = s2.Cells(a, "e").NumberFormat
s1.Cells(son, "e") = s2.Cells(a, "e")
If c = 1 Then
s1.Cells(son, "a") = deger
c = 0
End If
son = son + 1
Next
End Sub

 

[asubsubaru]

süper oldu teşekkür ederim eline sağlık

 

[asubsubaru]

ustad durup dururken şöyle bir hata vermeye başladı nedeni ne olabilir

 

[usubaykan]

Merhaba;

Hatanın sebebi Sayfa1 in [A:A] satırlarında Sayfa2 nin [A:A] satırlarındaki değerin olmaması eklemiş olduğunuz dosya da sayfa1 "WTG03" değeri görünmüyor verilerinizi kontrol etmelisiniz.

Yada;

Levent beyin hazırlamış olduğu koda

Sub arayaekle()
Set S1 = Sheets("sayfa1")
Set S2 = Sheets("sayfa2")
For a = 1 To S2.[b65536].End(3).Row
[COLOR=Red]Değer_Say = WorksheetFunction.CountIf(S1.[A:A], S2.Cells(a, "A"))[/COLOR]
If S2.Cells(a, "a") <> "" Then
[COLOR=Red]Son_Satır = S1.Range("A65536").End(3).Row + 1
If Değer_Say = 0 Then S1.Cells(Son_Satır, "A") = S2.Cells(a, "A")[/COLOR]

ekleyip tekrar deneyin. Kırmızı işaretli kodlar bulunmayan değeri otomatik olarak eklemektedir.

 

[asubsubaru]

sizin söylediğiniz şekilde yaptım fakat gene aynı hatayı verdi dün akşam çok güzel çalışıyordu şimdi hata vermeye başladı nedenini anlayamadım

 

[usubaykan]

Merhaba;

Ben ekli dosyanıza Levent beyin yazmış olduğu kodu uyguladım ve 25. satırda hata aldım. O yüzden diğer sayfa dan eşleştiremediği satır daki değeri Sayfa1 e yazdırdım. Hatanız anladığım kadarıyla "Son" değişkeninden kaynaklı. Peki siz hata aldığınız dosyanızı ekleyebilir misiniz?

sizin söylediğiniz şekilde yaptım fakat gene aynı hatayı verdi dün akşam çok güzel çalışıyordu şimdi hata vermeye başladı nedenini anlayamadım

 

[Levent Menteşoğlu]

Dosyanızda "son" değişkeniyle aynı adı taşıyan bir prosedür mevcut. Bu sebeple bu hata mesajını alıyorsunuz. Prosedürün yada değişkenin adını değiştirin.

 

[asubsubaru]

ilginize teşekkür ediyorum son değişkeniyle alakalıymış olay son diye bir sayfa açmıştım sayfayı silmeme rağmen bu hatayı veriyordu formüldeki son değerini sonn olarak değiştirdim düzeldi teşekkür ediyorum elinize sağlık