Hücre Değeri Değiştirerek Çoklu Yazdırma

[aytacesmebasi]

Herkese merhaba; toplu şekilde mektup göndereceğim ve her mektuba numara vermem gerekiyor ve elimde bir liste var, örneği şu şekilde;
A(Sütunu)___________ D(Sütunu)
1______________________aytaç çeşmebaşı
2______________________ excelwebtr
3______________________ googlecomtr

Düğmeye bastığımda MEKTUP sayfasındaki sayfa numarasını ve ismi her seferinde bir sonraki ile değiştirip yazdırsın. Ben sağdan soldan kopya çekerek bir şekilde aşağıdaki kodu yazdım ama eksik bilgim nedeniyle tıkandım, kodun da eksik olduğunu biliyorum

Private Sub CommandButton1_Click()
Set s1 = ThisWorkbook.Worksheets("MEKTUP")
Set s2 = ThisWorkbook.Worksheets("LISTE")
For i = 2 To s2.Range("a65536").End(xlUp).Row
s1.Range("B10").Value = s2.Range("A2").Value
s1.Range("A15").Value = s2.Range("D2").Value
s1.Range("A1:I52").PrintOut
End Sub

 

[veyselemre]

        s1.Range("B10").Value = s2.Range("A" & i).Value
        s1.Range("A15").Value = s2.Range("D" & i).Value

 

[aytacesmebasi]

@veyselemre hocam sıkıntı ve eksiklik sadece o satırlarda değil sanırım. Sizin öneriniz ve sağdan soldan kopyalamakla formül aşağıdaki şekli aldı

Private Sub CommandButton1_Click()
Set s1 = ThisWorkbook.Worksheets("MEKTUP")
Set s2 = ThisWorkbook.Worksheets("LISTE")
For i = 2 To s1.Range("a100").End(xlUp).Row
If s1.Range("B10").Value = s2.Range("A3").Value Then
s1.Range("B10").Value = s2.Range("A" & i).Value
s1.Range("A15").Value = s2.Range("D" & i).Value
s1.Range("A1:I52").PrintOut

End If
Next i

End Sub

 

[veyselemre]

Sıkıntı nerede ben denedim çalışıyor, sayfa adları doğruysa LISTE yerine LİSTE değilse bir sorun gözükmüyor, sıkıntı devam ederse örnek dosya ekleyin.

 

[aytacesmebasi]

Sıkıntı nerede ben denedim çalışıyor, sayfa adları doğruysa LISTE yerine LİSTE değilse bir sorun gözükmüyor, sıkıntı devam ederse örnek dosya ekleyin.

Hocam sıkıntının nerede olduğunu bilmiyorum sadece çalışmadı diye uyarı aldım fakat biraz daha değişiklik yaparak çözdüm. Aşağıdaki kod istediğim şekilde çalışıyor. Bir tek eksiği var o da şu; koddan da anladığınız gibi 2'den 100'e kadar çalışıtırıyor makroyu. Ben istiyorum ki boş hücreye geldi mi makro dursun. Yani 2'den 101'e geldiğinde eğer hücre boşsa dursun. Bunu da eklersem müthiş olacak benim için ve acayip derecede işlerimi rahatlatacak.

Private Sub CommandButton1_Click()
Set s1 = ThisWorkbook.Worksheets("MEKTUP")
Set s2 = ThisWorkbook.Worksheets("LISTE")
For i = 2 To 100
s1.Range("B10").Value = s2.Range("A" & i).Value
s1.Range("A15").Value = s2.Range("D" & i).Value
s1.Range("A1:I52").PrintOut
Next i
End Sub

 

[veyselemre]

Ben istiyorum ki boş hücreye geldi mi makro dursun. Yani 2'den 101'e geldiğinde eğer hücre boşsa dursun.

Private Sub CommandButton1_Click()
    Set s1 = ThisWorkbook.Worksheets("MEKTUP")
    Set s2 = ThisWorkbook.Worksheets("LISTE")
    For i = 2 To 10000
        If s2.Range("A" & i).Value = "" Then Exit Sub
        s1.Range("B10").Value = s2.Range("A" & i).Value
        s1.Range("A15").Value = s2.Range("D" & i).Value
        s1.Range("A1:I52").PrintOut
    Next i
End Sub

 

[aytacesmebasi]

@veyselemre hocam teşekkür ederim, tam da istediğim gibi çalıştı ????