Ardışık Satır Kopyalama

[orhncbk]

Merhaba A1 ile J4000 arasında veriler var
Yapmak istediğim ; Kod ile
A4 ile J4
A8ile j8 bu şekilde ardışık olarak A4000 J4000 arasını Sayfa 1 den kopyalayarak
Sayfa 2 1.satırdan itibaren yapıştırmak döngüyü kuramadım yardımcı olabilirmisiniz.

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kod ile yapabilirsiniz.

Sub test()
    Dim Bak As Integer
    Dim Alan As String
    For Bak = 4 To Worksheets("Sayfa1").Cells(Rows.Count, "A").End(xlUp).Row Step 4
        If Alan = "" Then
            Alan = "A" & Bak & ":J" & Bak
        Else
            Alan = Alan & "," & "A" & Bak & ":J" & Bak
        End If
    Next
    Worksheets("Sayfa1").Range(Alan).Copy Worksheets("Sayfa2").Range("A1")
End Sub

 

[kulomer46]

Merhaba

Aşağıdaki module kodu işinizi görür.

Kolay Gelsin.

Sub Aktar()
'25.12.2019   12:56

Cells.Clear
sona = Sheets("Sayfa1").Cells(Rows.Count, 1).End(3).Row
For i = 4 To sona Step 4
    Sheets("Sayfa1").Range("A" & i & ":J" & i).Copy  
    sonaa = Cells(Rows.Count, 1).End(3).Row + 1
    Range("A" & sonaa).Select
    ActiveSheet.Paste
Next
Application.CutCopyMode = False

End Sub

 

[orhncbk]

kulomer 46 Cells.Clear dan dolayı herşeyi siliyor
onu kaldırıncada Sayfa 1de 4000.satırdan sonraki satıra yapıştırıyor
2.sayfada a1 e yapıştırırsa sorun çözülecek

 

[orhncbk]

dalgalıkur kodun son satırında sıkıntı var sanırım çalışmadı

 

[kulomer46]

Yukarda #4 nolu mesajınız.
(kulomer 46 Cells.Clear dan dolayı herşeyi siliyor
onu kaldırıncada Sayfa 1de 4000.satırdan sonraki satıra yapıştırıyor
2.sayfada a1 e yapıştırırsa sorun çözülecek)

Merhaba

Yukardaki son taleplerinize göre düzenlenmiş kod aşağıdadır.

Kolay Gelsin.

Selamlar...

Sub Aktar()
'25.12.2019   12:56
sona = Sheets("Sayfa1").Cells(Rows.Count, 1).End(3).Row

For i = 4 To sona Step 4
    say=say+1
    Sheets("Sayfa1").Range("A" & i & ":J" & i).Copy
    Range("A" & say).Select
    ActiveSheet.Paste
Next
Application.CutCopyMode = False

End Sub

 

[Muzaffer Ali]

dalgalıkur kodun son satırında sıkıntı var sanırım çalışmadı

Sayfa1 ve Sayfa2 yerine kendi sayfalarınızın adını yazacaksınız.

 

[orhncbk]

dosyayı yükledim malesef çalışmadı birde burda bakabilirmisiniz

 

[Muzaffer Ali]

Şu kodları kullanın o zaman.

Sub test()
    Dim Bak As Integer
    Dim Alan As String
    For Bak = 4 To Worksheets("Sayfa1").Cells(Rows.Count, "A").End(xlUp).Row Step 4
        Alan = "A" & Bak & ":J" & Bak
        Worksheets("Sayfa1").Range(Alan).Copy Worksheets("Sayfa2").Range("A" & Worksheets("Sayfa2").Cells(Rows.Count, "A").End(xlUp).Row + 1)
    Next
    MsgBox "İşlem bitti."
End Sub

 

[kulomer46]

Merhaba

Kendi çözümümü içeren dosyanız Ek' tedir.

Selamlar...

 

[orhncbk]

Dalgalı kur oldu teşekkür ederim
Bişe daha istesem sizden öğrenmek adına
Burda sırası ile yaptığımız işlemleri söylermisiniz bende yeni yeni öğreniyorum

sırası ile ne yaptırdık kodlara yazmanız zor olmaz ise

 

[Muzaffer Ali]

Sub test()
    Dim Bak As Integer'Bir sayı değişkeni tanımladık
    Dim Alan As String 'Bir metin değişkeni tanımladık
    For Bak = 4 To Worksheets("Sayfa1").Cells(Rows.Count, "A").End(xlUp).Row Step 4 ' döngü kodudur.
'Bak sayı değişkeni 4 ile Sayfa1 deki A kolonunda bulunan son satır numarasına kadar arada bir sayıdır ve 4'ün katları bir sayıdır. Her döngü döndüğünde  Bak rakamına 4 ekler.
        Alan = "A" & Bak & ":J" & Bak ' Alan metin değişkenine veri atanıyor.
'"A" & Bak = ilk döngüde A4  hücresidir, ikincide A8  hücresidir. Böyle ardışık devam eder.
'Aynı şekilde "J" & Bak hücresi de ilk döngüde J4 hücresidir ve ardışık devam eder.
'Buna göre "A" & Bak & ":J" & Bak = ilk döngüde "A4:J4" hücrelerini temsil eder. Ve 4 rakamları 4 ün katları olarak artar.
        Worksheets("Sayfa1").Range(Alan).Copy Worksheets("Sayfa2").Range("A" & Worksheets("Sayfa2").Cells(Rows.Count, "A").End(xlUp).Row + 1)
' Sayfa1 in Alan değişkenine tanımladığımız hücre aralığı kopyalanır(Copy) Sayfa2 nin ilk A sütununun ilk boş hücresine yapıştırılır.
    Next' Döngü bitimi
    MsgBox "İşlem bitti."-
End Sub

VBA bölümünde bulunan menülerden "Wiev/Locals Window" açın.

Bu kodları çalıştırırken kodlardan her hangi bir satır seçili iken F8 tuşuna basarak satır satır çalıştırın. Değişkenlerin aldığı değerleri Locals Window dan gözlemleyin.

Kodları adım adım çalıştırmanız anlamanızı kolaylaştırır.

Başka öğrenmek istediğin bir konu olursa çekinme, müsait oldukça ve dilim döndükçe anlatmaya çalışırım.


Kolay gelsin.