- Katılım
- 8 Haziran 2007
- Mesajlar
- 761
- Excel Vers. ve Dili
- excel- 2003 Türkçe
Arkadaşlar aşağıdaki kodu uyarlamaya çalışıyorum. Kodu anlamadığım için çözemedim. BENİM YAPMAK İSTEDİĞİM DATA SAYFASINDAN VERİLERİ ÖZEL SAYFASINA AKTARMAK
Private Sub CommandButton1_Click()
On Error Resume Next
If TextBox1 = "" Then
MsgBox ("Mahkeme Adını Giriniz")
Exit Sub
End If
Sheets("Özel").Select
Sheets("Özel").Range("bw11:bw21").ClearContents
c = 0
sat = 0
Sheets("Özel").[k1] = Now
Sheets("Özel").[k2] = 1
For a = 8 To Sheets("Data").Cells(65536, 2).End(xlUp).Row + 8
tarih = TextBox1.Value
If Sheets("Data").Cells(a, 9).Value = tarih Then
c = c + 1
Sheets("Özel").Cells(c + 7, 1) = Sheets("Data").Cells(a + sat, 2).Value
Sheets("Özel").Cells(c + 7, 2) = Sheets("Data").Cells(a + sat, 3).Value
Sheets("Özel").Cells(c + 7, 3) = Sheets("Data").Cells(a + sat, 4).Value
If c / 14 = Int(c / 14) Then
c = 0
soru = MsgBox("SAYFA DOLDU,EVET DERSENİZ YAZDIRDIKTAN SONRA DEVAM EDİLECEKTİR", vbYesNo, "YAZDIRILMADAN DEVAM EDİLECEKTİR")
If soru = vbYes Then
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End If
Sheets("Özel").Range("A8:C21").ClearContents
Sheets("Özel").[k2] = Sheets("Özel").[k2] + 1
End If
End If
Next a
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
If TextBox1 = "" Then
MsgBox ("Mahkeme Adını Giriniz")
Exit Sub
End If
Sheets("Özel").Select
Sheets("Özel").Range("bw11:bw21").ClearContents
c = 0
sat = 0
Sheets("Özel").[k1] = Now
Sheets("Özel").[k2] = 1
For a = 8 To Sheets("Data").Cells(65536, 2).End(xlUp).Row + 8
tarih = TextBox1.Value
If Sheets("Data").Cells(a, 9).Value = tarih Then
c = c + 1
Sheets("Özel").Cells(c + 7, 1) = Sheets("Data").Cells(a + sat, 2).Value
Sheets("Özel").Cells(c + 7, 2) = Sheets("Data").Cells(a + sat, 3).Value
Sheets("Özel").Cells(c + 7, 3) = Sheets("Data").Cells(a + sat, 4).Value
If c / 14 = Int(c / 14) Then
c = 0
soru = MsgBox("SAYFA DOLDU,EVET DERSENİZ YAZDIRDIKTAN SONRA DEVAM EDİLECEKTİR", vbYesNo, "YAZDIRILMADAN DEVAM EDİLECEKTİR")
If soru = vbYes Then
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End If
Sheets("Özel").Range("A8:C21").ClearContents
Sheets("Özel").[k2] = Sheets("Özel").[k2] + 1
End If
End If
Next a
End Sub