6 satır atlayarak kopyala ve değer olarak yapıştır

[euphrates55]

bir sütundaki belirlenen ilk hücreden itibaren 6 satır atlayarak belirlenen son satır numarasına kadar tüm hücre kopyalanacak ve belirlemiş olduğum diğer ilk hücreden itibaren 6 atlayarak son satıra kadar değer yapıştıracak. bu şekilde makro yardımına ihtiyacım var. ekte ayrıntılı açıkladım. teşekkürler

 

[hamitcan]

Böyle bir şey mi istiyor sunuz ?

Sub AtlaKopyala()
    x = 3
    For i = 9 To 1575 Step 6
       Range(Cells(i, "e"), Cells(i, "k")) = Range(Cells(x, "e"), Cells(x, "k")).Value
       x = x + 6
    Next
End Sub

 

[euphrates55]

Sub FormulKopyaladegeryapistir()
    Dim i As Integer
xy = InputBox("kopyalanacak başlangıç hücresini yaz")
    If xy = "" Then
    MsgBox "kopyalanacak başlangıç hücresini yazmadınız.", vbInformation, "        Uyarı"
    Exit Sub
    End If
ab = InputBox("yapıştırılacak başlangıç hücresini yaz")
    If ab = "" Then
    MsgBox "yapıştırılacak başlangıç hücresini yazmadınız.", vbInformation, "        Uyarı"
    Exit Sub
    End If
sh = InputBox("son satır sayısı (harfsiz)")
    If sh = "" Then
    MsgBox "son satır numarasını yazmadınız.", vbInformation, "        Uyarı"
    Exit Sub
    End If
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

    x = Range("" & xy & "").Row
    y = Range("" & xy & "").Column
    a = Range("" & ab & "").Row
    b = Range("" & ab & "").Column

 
    For i = x To sh Step 6
    Cells(i, y).Copy
    Cells(i, b).PasteSpecial Paste:=xlPasteValues
    Next i
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "T A M A M", vbInformation, "        Uyarı"
End Sub

Bu şekilde çözdüm. mantık hatalarım olabilir. işlem sorunsuz sonuçlanıyor

 

[euphrates55]

yukarıdaki koda (3. yorum) yapıştırılan değer sıfır ise sıfır yazmasın sıfırı silsin (boş bıraksın kodunu nasıl nereye eklemeliyim.