button ile satır satır kayıt nasıl yapılır

[cxaner]

herkese merhabalar

1. çalışma sayfasında A1 A2 B1 B2 hücrelerine sayılar yazdım.
2. çalşma sayfasında A1 den A500e kadar 1.2.3...500 yazıyor.
1. çalışma sayfasında butona basınca
2. çalışma sayfasında,1. çalışma sayfasındaki A1 deki sayı (örneğin 21) ile tanımlanan satıra gidip A2 yi B21'e B1'i C21 B2'yi D21'e yazmasını istiyorum.

Bunun için makro mu kullanmam gerekiyor. Nasıl bir kod gerekir. Yardım eden herkese şimdiden teşekkürler.

 

[muygun]

Merhaba;
Sayfanın kod bölümüne;

Sub sayfaya_yaz()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("1.çalışma")
Set s2 = ThisWorkbook.Worksheets("2.çalışma")
For i = 1 To s2.Range("A65536").End(xlUp).Row
If s2.Cells(i, "a") = s1.Cells(1, 1) Then
s2.Cells(i, "b") = s1.Cells(2, "a")
s2.Cells(i, "c") = s1.Cells(1, "b")
s2.Cells(i, "d") = s1.Cells(2, "b")
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Kodlarını ekleyin ve bir butona bağlayın.
İyi çalışmalar.

 

[Muzaffer Ali]

...........

 

[cxaner]

Çok Teşekkürler işin içine döngü komutlarının gireceğini tahmin etmemiştim açıkcası. GoTo gibi bir komutla olabilir diye düşünüyordum.

Forum konusundan yararlanıp komutu deneyecek olan arkadaşlara bir uyarı yapmak istiyorum. Çalışma sayfalarınızın ismini komuttaki gibi değiştirmeyi unutmayın. ben unuttum çalışmadı

 

[cxaner]

Bu komuta 20. satırdaki herhangi bir sütuna daha önce sayı yazıldı ise tekrar sayı yazılmasını engelleyecek bir komut ekleyebilir miyiz?

 

[muygun]

Merhaba;
Kodları aşağıdaki şekilde düzenleyin.

Sub sayfaya_yaz()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("1.çalışma")
Set s2 = ThisWorkbook.Worksheets("2.çalışma")
For i = 1 To s2.Range("A65536").End(xlUp).Row
If s2.Cells(i, "a") = s1.Cells(1, 1) And s2.Cells(i, "b") <> "" Then
MsgBox "BU ALANDA KAYIT VAR. KAYIT İŞLEMİ YAPILMADI.", vbInformation
End If
If s2.Cells(i, "a") = s1.Cells(1, 1) And s2.Cells(i, "b") = "" Then
s2.Cells(i, "b") = s1.Cells(2, "a")
s2.Cells(i, "c") = s1.Cells(1, "b")
s2.Cells(i, "d") = s1.Cells(2, "b")
MsgBox "İşlem TAMAM.", vbInformation
End If
Next i
Application.ScreenUpdating = True
End Sub

İyi çalışmalar.

 

[muygun]

Aslında işin içine döngü girmeyebilirdi. (A1 hücresine yazdığınız rakam satır nosu olarak alınabilirdi.)
Ama 2.sayfada herhangi satırı sildiğinizde yada sıralı rakamlardan birini atladığınızda kayıt doğru yere gitmezdi.