for next

[excellcan]

Forumda emeği geçen herkese merhaba. Arkadaşlar aşağıdaki gibi makro kodlarım var. T17 ye formül ile hücre adresi çağırıyorum. Q17:R17 aralığını da ilgili adrese yapıştırıyorum. Fakat bazen hücre adresi yok değeri verebiliyor. Sorunum aşağıdaki kodlara şöyle bir kod eklemek. Eğer T17 yok değeri veriyorsa O17:R17 yi kopyalayıp F21:F620 aralığında ilk boş hücreye yapıştırsın. İlgilenen arkadaşlara şimdiden teşekkürler.

For i = 1 To 12
Range("N17") = i
Range("Q17:R17").Copy
Range([T17]).Select
Selection.PasteSpecial Paste:=xlPasteValues
J = J + 1

Next i

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub ÖRNEK()
    Dim i As Byte, j As Byte
    For i = 1 To 12
        Range("N17") = i
        Range("Q17:R17").Copy
        If IsError([T17]) Then
            Range("F65536").End(3).Offset(1).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            j = j + 1
        Else
            Range([T17]).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            j = j + 1
        End If
    Next i
End Sub

 

[excellcan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub ÖRNEK()
    Dim i As Byte, j As Byte
    For i = 1 To 12
        Range("N17") = i
        Range("Q17:R17").Copy
        If IsError([T17]) Then
            Range("F65536").End(3).Offset(1).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            j = j + 1
        Else
            Range([T17]).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            j = j + 1
        End If
    Next i
End Sub

Hocam kodlar çalışıyor. İlginiz için çok teşekkür ederim. Yalnız T17 de hata vermesi durumunda O17:R17 yi kopyalamasını istemiştim. Bu kodlarda T17 de hata verse bile Q17:R17 yi kopyalıyor.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki şekilde denermisiniz.

Option Explicit
 
Sub ÖRNEK()
    Dim i As Byte, j As Byte
    For i = 1 To 12
        Range("N17") = i
        If IsError([T17]) Then
            Range("Q17:R17").Copy
            Range("F65536").End(3).Offset(1).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            j = j + 1
        End If
    Next i
End Sub

 

[excellcan]

Korhan hocam ilginiz için tekrar çok teşekkürler. Kodları aşağıdaki gibi düzelttim oldu. Ola ki başka arkadaşların işine yarar.


Dim i As Byte, j As Byte
For i = 1 To 12
Range("N17") = i
Range("Q17:R17").Copy
If IsError([T17]) Then
Range("O17:R17").Copy

Range("F65536").End(3).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues
j = j + 1
Else
Range([T17]).Select
Selection.PasteSpecial Paste:=xlPasteValues
j = j + 1
End If
Next i