Vba kopyalama yaparken hücre dolu ise alt satıra yazdırma

[RONIN1]

Merhaba

Aşağıdaki komut satırına yardımlarınızla bir ekleme yapmak istiyorum.

B3 dolu ise B4 e oda dolu ise B5,6,7, vs.

Şimdiden teşekkürler

Range("P4").Select
Selection.Copy
Sheets("Sayfa1").Select
Range("b3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sayfa2").Select
Application.CutCopyMode = False

 

[Necdet]

Merhaba,

Aşağıdaki şekilde deneyiniz.

Sub Aktar()
    
    Dim i   As Long
    
    i = Sheets("Sayfa1").Cells(Rows.Count, "B").End(3).Row + 1
    If i < 3 Then i = 3
    
    Range("P4").Copy
    Sheets("Sayfa1").Range("B" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Application.CutCopyMode = False
    
End Sub

 

[Mesafe]

Asağıdaki şekilde deneyin

Sub ronin()
    satir = Sheets("sayfa1").Range("B65536").End(3).Row + 1
    Range("P4").Select
    Selection.Copy
    Sheets("Sayfa1").Select
    Cells(satir, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Sayfa2").Select
    Application.CutCopyMode = False
End Sub

makro kaydetden çıkan kodlar üzerinde ufak değişiklikler yaparak kod çalışırken gereksiz ordan oraya gitmeleri selectleri kaldırabilirsiniz.
Örneğin, Range("P4").Copy
iyi çalışmalar

 

[RONIN1]

Merhaba

Sayın Necdet Bey ve Sayın Mesafe.

İlginize teşekkür ederim.

Tam olarak oldu.

İyi çalışmalar

 

[serukanu]

Merhaba,

Aşağıdaki şekilde deneyiniz.

Sub Aktar()
   
    Dim i   As Long
   
    i = Sheets("Sayfa1").Cells(Rows.Count, "B").End(3).Row + 1
    If i < 3 Then i = 3
   
    Range("P4").Copy
    Sheets("Sayfa1").Range("B" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
   
End Sub

Selamlar Necdet bey,
bu işlemi aynı anda, farklı sayfalardan da kopyalayacak şekilde nasıl yapabiliriz?