Makro ile taşı kopyala formülü ne ilave.

[ahzola]

Tüm forum sakinlerine hayırlı akşamlar diliyorum.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A2222]) Is Nothing Then Exit Sub
If Cells(Target.Row, 1).Value = "" Then
ElseIf Cells(Target.Row, 1).Value = 0 Then
Rows(Target.Row + 1).Insert
Range(Cells(Target.Row, 2), Cells(Target.Row, 19)).Copy
Cells(Target.Row + 1, 2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Cells(Target.Row, 1).Select
ElseIf Cells(Target.Row, 1).Value = 1 Then
sonsat = Cells(Rows.Count, 2).End(3).Row + 1
Range(Cells(Target.Row, 2), Cells(Target.Row, 19)).Copy
Cells(sonsat, 2).Select
ActiveSheet.Paste
Range(Cells(Target.Row, 2), Cells(Target.Row, 19)).ClearContents
Application.CutCopyMode = False
Cells(Target.Row, 1).Select
End If
End Sub


Konuya vakıf üstadlar anlayacaklardır.

Yukarıdaki formülümüz A sütununda çalışıyor.
A sütununa
0 (sıfır) değeri girer isek ilgili satırda ki değerlerin tamamını hemen alt satırına kopyalıyor.
1 (bir) değeri girer isek ilgili satırı sayfadaki değer olan en alt satırın altına taşıyor/kopyalıyor.

Benim istirhamım. Formülümüzü biraz daha kullanışlı hale getirmek.

örneğin.
1 yazdığımızda 1 satır kopyalasın
2 yazdığımızda 2 satır kopyalasın.

3 yazdığımızda 1 satır taşısın
4 yazdığımızda 2 satır taşısın
5 yazdığımızda 5 satır taşısın
6 yazdığımızda 10 satır taşısın

yukarıdaki formülü epey bir süre önce değerli üstadımız.
Sn Hüseyin Kış bey yapıvermişti. Buradan kendisine hürmetlerimi sunuyorum.

Yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.
esinlikler diliyorum.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kod yapısını isteğinize göre uyarlayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1:A5000")) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub
    
    Select Case Target
        Case 0
            Range("B" & Target.Row + 1 & ":S" & Target.Row + 1).FillDown
        Case 1
            Satir = Cells(Rows.Count, 2).End(3).Row + 1
            Range("B" & Target.Row & ":S" & Target.Row).Copy _
            Destination:=Range("B" & Satir & ":H" & Satir)
        Case 2
            Satir = Cells(Rows.Count, 2).End(3).Row + 1
            Range("B" & Target.Row - 1 & ":S" & Target.Row).Copy _
            Destination:=Range("B" & Satir & ":H" & Satir)
    End Select
End Sub

 

[ahzola]

Çok çok teşekkür ederim
sayın Korhan bey.
Emeğinize yüreğinize sağlık.