20.kayıttan sonraki aktarma sorunu hk.

[chakistes]

Merhaba arkadaşlar sayfa 1 de listbox 2 deki verileri yazdır dediğimde 1-10 arası excelde A-C-D 10.kayıttan sonrası G-I-J doğru aktarıyor ama 20.kayıttan sonraski ile 20-30 arası kayıtları sayfa 2 de A-C-D 30.kayıttan sonrasını G-I-J aktarmasını yapamadım
bu konuda yardımınıza ihtiyacım var
For ii = 0 To ListBox2.ListCount - 1
q = sayi + 2

If ii <= 9 Then
Range("A" & q) = sayi
Range("C" & q) = ListBox2.Column(0, (ii))
Range("D" & q) = ListBox2.Column(2, (ii))
End If

'-----------------------------------------------------

If ii > 9 Then
Range("G" & (q - 10)) = sayi
Range("I" & (q - 10)) = ListBox2.Column(0, (ii))
Range("J" & (q - 10)) = ListBox2.Column(2, (ii))
End If
'-----------------------------------------------------
If ii > 19 Then
Range("A" & (q - 20)) = sayi
Range("C" & (q - 20)) = ListBox2.Column(0, (ii))
Range("D" & (q - 20)) = ListBox2.Column(2, (ii))
End If
If ii > 29 Then
Range("G" & (q - 30)) = sayi
Range("I" & (q - 30)) = ListBox2.Column(0, (ii))
Range("J" & (q - 30)) = ListBox2.Column(2, (ii))
End If

sayi = sayi + 1

 

[askm]

Sanırım aşağıdkai gibi;

Private Sub yazdır_Click()
Sheets("sayfa2").Activate
On Error Resume Next
Sheets("sayfa2").Range("A1:V80").ClearContents
'----------------------
On Error Resume Next
Dim resimler As Integer
resimler = ActiveSheet.Pictures.Count
For i = 1 To resimler
ActiveSheet.Pictures(1).Delete
Next

ActiveSheet.DrawingObjects.Delete
[A1] = "     2017-2018 EĞİTİM ÖĞRETİM YILI ŞUBE ÖĞRETMENLER KURULU " & ogretmengorus.TextBox1 & " ÖĞRETMEN GÖRÜŞ RAPORU"
[A2] = " S.NO"
[B2] = "RESİM"
[C2] = "ADI SOYADI"
[D2] = "OKUL NO"
[E2] = "ÖĞRETMEN GÖRÜŞÜ"

[G2] = " S.NO"
[H2] = "RESİM"
[I2] = "ADI SOYADI"
[J2] = "OKUL NO"
[K2] = "ÖĞRETMEN GÖRÜŞÜ"


'----------------------------------------------------

Dim sayi
If Target.Column = 1 Then
sayi = 1

'-----------------------------------------------------
For ii = 0 To ListBox2.ListCount - 1
q = sayi + 2

If ii <= 9 Then
Range("A" & q) = sayi
Range("C" & q) = ListBox2.Column(0, (ii))
Range("D" & q) = ListBox2.Column(2, (ii))
End If

'-----------------------------------------------------

If ii > 9 And ii <= 19 Then
Range("G" & (q - 10)) = sayi
Range("I" & (q - 10)) = ListBox2.Column(0, (ii))
Range("J" & (q - 10)) = ListBox2.Column(2, (ii))
End If
'-----------------------------------------------------
If ii > 19 And ii <= 29 Then
Range("A" & (q - 10)) = sayi
Range("C" & (q - 10)) = ListBox2.Column(0, (ii))
Range("D" & (q - 10)) = ListBox2.Column(2, (ii))
End If
If ii > 29 Then
Range("G" & (q - 20)) = sayi
Range("I" & (q - 20)) = ListBox2.Column(0, (ii))
Range("J" & (q - 20)) = ListBox2.Column(2, (ii))
End If

sayi = sayi + 1



'-----------------------------------------------------

Next

Application.Visible = True
Me.Hide
Sheets("sayfa2").PrintPreview
Application.Visible = False
Me.Show
End If
End Sub

 

[chakistes]

teşekkür ederim arkadaş tam istediğim gibi.

 

[askm]

Rica ederim. İyi geceler.