Macro İle Satır Atlatma

[DMR 7]

Merhabalar, bir macro yazmaya çalıştım. Amacım A3:A8'den kopyalanan veriyi daha sonra B2'ye yatay yapıştırıp, az önce kopyalanan veriyi silmesi ve bir sonraki loop'ta

Aynısını A10:A15 için B9'ya yapması.. bu şekilde 1900 satır var yaklaşık ama yazım şeklini yapamadım gibi. Yardımcı olur musunuz?

Sub Yataykopyala()

' Yataykopyala Makro

Dim x As Integer

For x = 1 To 1870 Step 8

Range("A(x + 2)", "A(x + 7)").Select
Selection.Copy
Range("B(x+1)").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A(x+2),A(x+7)").Select
Application.CutCopyMode = False
Selection.ClearContents

Next x
End Sub

 

[RBozkurt]

Bu şekilde mi?

Sub Yataykopyala()
    Dim x As Integer
    Dim sourceRange As Range
    Dim destCell As Range

    For x = 1 To 1898 Step 8
        Set sourceRange = Range("A" & (x + 2) & ":A" & (x + 7))
        Set destCell = Range("B" & (x + 1))
       
        sourceRange.Copy
        destCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
       
        sourceRange.ClearContents
        Application.CutCopyMode = False
    Next x
End Sub

 

[programer]

Merhaba aşağıdaki gibi dener misiniz.

Sub Yataykopyala()

' Yataykopyala Makro

Dim x As Integer

For x = 1 To 1870 Step 8

Range("A" & (x + 2) & ":" & "A" & (x + 7)).Select
Selection.Copy
Range("B" & (x + 1)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A" & (x + 2) & ":" & "A" & (x + 7)).Select
Application.CutCopyMode = False
Selection.ClearContents

Next x
End Sub

 

[muygun]

Merhaba;

Sub Yataykopyala()
Range("b2:b65536").ClearContents
For i = 1 To Range("A65536").End(xlUp).Row Step 8
sonsatir = Range("b65536").End(xlUp).Row + 1
Cells(sonsatir + 0, 2) = Cells(i + 0, 1)
Cells(sonsatir + 1, 2) = Cells(i + 1, 1)
Cells(sonsatir + 2, 2) = Cells(i + 2, 1)
Cells(sonsatir + 3, 2) = Cells(i + 3, 1)
Cells(sonsatir + 4, 2) = Cells(i + 4, 1)
Cells(sonsatir + 5, 2) = Cells(i + 5, 1)
Cells(sonsatir + 6, 2) = Cells(i + 6, 1)
Cells(sonsatir + 7, 2) = Cells(i + 7, 1)
Next i
Rem Range("a3:a65536").ClearContents' Rem yazısını kaldırırsanız A sütunu silmiş olursunuz.
End Sub

şeklinde deneyin.
İyi çalışmalar.