• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Belirlenen hücreleri belli koşulla alt satıra kopyalama-silme

G

gurayavci

Katılım
9 Ocak 2020
Mesajlar
48
Excel Vers. ve Dili
2010
Merhaba ,

Ekteki excel dosyasında gerekli açıklamayı yaptım.

B41 HÜCRESİNE VERİ GİRDİĞİMDE "A40-C40-E40-F40-G40---J40-K40-L40--N40-O40 HÜCRELERİNDEKİ VERİLERİN AŞAĞIDA İÇERİSİNDE VERİ OLAN HÜCRELERİ BİR ALT SATIRA(41. SATIRA) KOPYALAMASINI İSTİYORUM. Aynı şekilde bir alt satırda bulunan B42 hücresine veri girdiğimde 41. satırda bulunan belirttiğim sütunlardaki verilerin o satırdaki hizalarına kopyalanmasını istiyorum. B42 hücresindeki veri silindiğinde o satıra kopyalanan verilerin de silinmesi gerekiyor.

Konuyla ilgili desteğinizi rica ediyorum

Teşekkürler, Yeni yılınızı şimdiden kutluyorum
 

Ekli dosyalar

Aşağıdaki kodu sayfanın kod penceresine aynen yapıştırıp kullanabilirsiniz.
C++: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Target.Value <> "" And Target.Row > 1 Then
        Range("A" & Target.Row - 1).Copy Range("A" & Target.Row)
        Range("C" & Target.Row - 1).Copy Range("C" & Target.Row)
        Range("E" & Target.Row - 1).Resize(1, 3).Copy Range("E" & Target.Row).Resize(1, 3)
        Range("J" & Target.Row - 1).Resize(1, 3).Copy Range("J" & Target.Row).Resize(1, 3)
        Range("N" & Target.Row - 1).Resize(1, 2).Copy Range("N" & Target.Row).Resize(1, 3)
    ElseIf Target.Value = "" Then
        Range("A" & Target.Row).ClearContents
        Range("C" & Target.Row).ClearContents
        Range("E" & Target.Row).Resize(1, 3).ClearContents
        Range("J" & Target.Row).Resize(1, 3).ClearContents
        Range("N" & Target.Row).Resize(1, 2).ClearContents
    End If
    Application.EnableEvents = True
End Sub
 
Teşekkürler Ömer Bey,

Kod işime yaradı,

Sadece Kopyaladığı zaman N sütununun yanındaki O sütununu da kopyalıyor, Bu sütunda kopyalama olmaması gerekiyor, O sütunun kopyalanmaması için yapabileceğimiz birşey var mı ?
 
Önceki mesajınız şöyleydi
B41 HÜCRESİNE VERİ GİRDİĞİMDE "A40-C40-E40-F40-G40---J40-K40-L40--N40-O40 HÜCRELERİNDEKİ VERİLERİN AŞAĞIDA İÇERİSİNDE VERİ OLAN HÜCRELERİ BİR ALT SATIRA(41. SATIRA) KOPYALAMASINI İSTİYORUM

istemiyorsanız ilgili satırda aşağıdaki değişikliği yapınız.
Range("N" & Target.Row - 1).Resize(1, 2).Copy Range("N" & Target.Row).Resize(1, 3)
yerine
Range("N" & Target.Row - 1).Resize(1, 1).Copy Range("N" & Target.Row).Resize(1, 1)
 
ÖmerFaruk' Alıntı:
Önceki mesajınız şöyleydi
B41 HÜCRESİNE VERİ GİRDİĞİMDE "A40-C40-E40-F40-G40---J40-K40-L40--N40-O40 HÜCRELERİNDEKİ VERİLERİN AŞAĞIDA İÇERİSİNDE VERİ OLAN HÜCRELERİ BİR ALT SATIRA(41. SATIRA) KOPYALAMASINI İSTİYORUM

istemiyorsanız ilgili satırda aşağıdaki değişikliği yapınız.
Range("N" & Target.Row - 1).Resize(1, 2).Copy Range("N" & Target.Row).Resize(1, 3)
yerine
Range("N" & Target.Row - 1).Resize(1, 1).Copy Range("N" & Target.Row).Resize(1, 1)
Genişletmek için tıkla ...
Evet Ömer Bey öyle yazmıştım, bu kısmı düzeldi Teşekkür ederim,





Belirttiğiniz bilgi üzerinden kodları aşağıdaki şekilde düzenledim, Her satırda B hücresini sildiğimde o satırdakilein hepsini silmesi için düzenledim fakat 40. satırdaki B hücresini sildiğimde diğer hücreleri silmemesini sağlayamadım, 40. satırdaki hücreleri silmemesi için ne yapabilirim ?



Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Target.Value <> "" And Target.Row > 40 Then
        Range("A" & Target.Row - 1).Copy Range("A" & Target.Row)
        Range("C" & Target.Row - 1).Copy Range("C" & Target.Row)
        Range("E" & Target.Row - 1).Resize(1, 2).Copy Range("E" & Target.Row).Resize(1, 2)
        Range("J" & Target.Row - 1).Resize(1, 2).Copy Range("J" & Target.Row).Resize(1, 2)
        Range("N" & Target.Row - 1).Resize(1, 1).Copy Range("N" & Target.Row).Resize(1, 1)
        Range("M" & Target.Row - 1).Resize(1, 1).Copy Range("M" & Target.Row).Resize(1, 1)
ElseIf Target.Value = "" Then
 
        Range("A" & Target.Row).ClearContents
        Range("C" & Target.Row).ClearContents
                Range("D" & Target.Row).ClearContents
        Range("E" & Target.Row).Resize(1, 1).ClearContents
                Range("F" & Target.Row).Resize(1, 1).ClearContents
                                        Range("G" & Target.Row).Resize(1, 1).ClearContents
                                Range("H" & Target.Row).Resize(1, 1).ClearContents
                                        Range("I" & Target.Row).Resize(1, 1).ClearContents
        Range("J" & Target.Row).Resize(1, 1).ClearContents
                Range("K" & Target.Row).Resize(1, 1).ClearContents
                                        Range("L" & Target.Row).Resize(1, 1).ClearContents
        Range("M" & Target.Row).Resize(1, 1).ClearContents
        Range("N" & Target.Row).Resize(1, 1).ClearContents
 
    End If
    Application.EnableEvents = True
End Sub
 
ilgili silme kodlarını If-EndIf arasına alın

C++: 
If Target.Row<>40 Then
    '.............'
    'Silme kodlarınız
    '............'
End If
 
ÖmerFaruk' Alıntı:
ilgili silme kodlarını If-EndIf arasına alın

C++: 
If Target.Row<>40 Then
    '.............'
    'Silme kodlarınız
    '............'
End If
Genişletmek için tıkla ...

ilgili silme kodlarını if target <> 40 then ile end if arasına aldığımda evet ilk satırı silmiyor fakat ikinci satıra geldiğinde yukardan aşağı ilgili hücreleri kopyaladığı gibi siliyor Ömer Bey

ElseIf Target.Value = "" Then Bu satırı silmeyi denedim/ End if ten sonraya koymayı denedim, ikisinde de belirttiğim sonuç oluşuyor
 
Konu mu dağıldı ben mi kaçırdım anlamadım.
Siz B sütununda bir hüreye değer yazıncabir üst satır alt satıra kopyalanacak.
Siz B sütununda birhücreyi sildiğinizde o satırdaki belirttiğiniz sütunlar silinecek.
Eğer bu B sütunundaki silinen hücrenin satırı 40. satır ise diğer sütunları silmesin.
Bu mudur?
 
ÖmerFaruk' Alıntı:
Konu mu dağıldı ben mi kaçırdım anlamadım.
Siz B sütununda bir hüreye değer yazıncabir üst satır alt satıra kopyalanacak.
Siz B sütununda birhücreyi sildiğinizde o satırdaki belirttiğiniz sütunlar silinecek.
Eğer bu B sütunundaki silinen hücrenin satırı 40. satır ise diğer sütunları silmesin.
Bu mudur?
Genişletmek için tıkla ...


Ömer bey ilginiz beni sevindirdi çok teşekkür ediyorum,

Konu benim eksik bilgilendirmem sebebiyle dağınık görünüyor,
"B41 HÜCRESİNE VERİ GİRDİĞİMDE "A40-C40-E40-F40-G40---J40-K40-L40--N40-O40 HÜCRELERİNDEKİ VERİLERİN AŞAĞIDA İÇERİSİNDE VERİ OLAN HÜCRELERİ BİR ALT SATIRA(41. SATIRA) KOPYALAMASINI İSTİYORUM. Aynı şekilde bir alt satırda bulunan B42 hücresine veri girdiğimde 41. satırda bulunan belirttiğim sütunlardaki verilerin o satırdaki hizalarına kopyalanmasını istiyorum. B42 hücresindeki veri silindiğinde o satıra kopyalanan verilerin de silinmesi gerekiyor."

şeklinde belirtmiştim ve verdiğiniz kodu şu an kullanıyorum sadece önceden girilmiş verilerin tamamını temizleme konusunda sıkıntı yaşıyorum o sebeple yazdım

B sütunundaki işlem 40. satır itibari ile başlıyor fakat 40. satırdan aşağı kopyalayabilmesi için 40. satırdaki kopyalanan hücreleri(A40-C40-D40-E40-F40-I40-J40-K40-M40-N40) sabit tutup değişken hücreleri (B40-G40-H40 ve L40) hücrelerini silebilmem gerekiyor,

Bir diğer sorun ekteki düzenlediğim örnekte göreceğiniz B41 ile B59 arasına girdiğim verileri aşağıdan yukarı sırayla sildiğimde sıkıntı olmuyor fakat hepsini seçip tek seferde silince "Debug" uyarısı veriyor ve formül pasif hale geliyor, exceli kapatıp açtığımda ancak tekrar çalışıyor
 

Ekli dosyalar

Verdiğim kodu silin. Yerine aşağıdakini kopyalayın.
Silinmemesini ya da kopyalanmamasını istediğiniz sütunlar için verdiğim koddaki ilgili satırın başına Tek Tırnak ' işareti koymanız yeterli olacaktır.

C++: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Hcr As Range
    If Intersect(Target, Range("B41:B" & Rows.Count)) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each Hcr In Target.Rows
        If Range("B" & Hcr.Row) = "" Then
            'Burası örnektir. kopyalanmasını ya da silinmesini istemediğini sütun etiketinin
            'olduğu satırın başına ' tek tırnak işareti koyaabilirsiniz.
            'Range("O" & Target.Row) = Range("A" & Target.Row - 1)
            Range("A" & Hcr.Row).ClearContents
            Range("B" & Hcr.Row).ClearContents
            Range("C" & Hcr.Row).ClearContents
            Range("D" & Hcr.Row).ClearContents
            Range("E" & Hcr.Row).ClearContents
            Range("F" & Hcr.Row).ClearContents
            Range("G" & Hcr.Row).ClearContents
            Range("H" & Hcr.Row).ClearContents
            Range("I" & Hcr.Row).ClearContents
            Range("J" & Hcr.Row).ClearContents
            Range("K" & Hcr.Row).ClearContents
            Range("L" & Hcr.Row).ClearContents
            Range("M" & Hcr.Row).ClearContents
            Range("N" & Hcr.Row).ClearContents
        Else
            Range("A" & Hcr.Row) = Range("A" & Hcr.Row - 1)
            Range("C" & Hcr.Row) = Range("B" & Hcr.Row - 1)
            Range("D" & Hcr.Row) = Range("C" & Hcr.Row - 1)
            Range("E" & Hcr.Row) = Range("D" & Hcr.Row - 1)
            Range("F" & Hcr.Row) = Range("E" & Hcr.Row - 1)
            Range("G" & Hcr.Row) = Range("F" & Hcr.Row - 1)
            Range("H" & Hcr.Row) = Range("G" & Hcr.Row - 1)
            Range("I" & Hcr.Row) = Range("H" & Hcr.Row - 1)
            Range("J" & Hcr.Row) = Range("I" & Hcr.Row - 1)
            Range("K" & Hcr.Row) = Range("J" & Hcr.Row - 1)
            Range("L" & Hcr.Row) = Range("K" & Hcr.Row - 1)
            Range("M" & Hcr.Row) = Range("L" & Hcr.Row - 1)
            Range("N" & Hcr.Row) = Range("M" & Hcr.Row - 1)
        End If
    Next Hcr
    Application.EnableEvents = True
End Sub
 
Ömer Bey Harika olmuş,

uyarılarınıza müteakip aşağıdaki şekilde düzeltmeler yaptım, ilk satırdaki A hücresini alt satıra B hücresine kopyalıyordu, düzelttim, kod aşağıdaki gibi.

ilk satırı(40 numara) tek başına sildiğimde sıkıntı olmuyor fakat B sütunundaki tüm satırları sildiğimde 40 numaralı satırın da tamamını siliyor, 40 numaralı satırı toplu silimde sildirmeme şansımız var mıdır ?

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Hcr As Range
    If Intersect(Target, Range("B41:B" & Rows.Count)) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each Hcr In Target.Rows
        If Range("B" & Hcr.Row) = "" Then
            'Burası örnektir. kopyalanmasını ya da silinmesini istemediğini sütun etiketinin
            'olduğu satırın başına ' tek tırnak işareti koyaabilirsiniz.
            'Range("O" & Target.Row) = Range("A" & Target.Row - 1)
            Range("A" & Hcr.Row).ClearContents
            'Range("B" & Hcr.Row).ClearContents
            Range("C" & Hcr.Row).ClearContents
            Range("D" & Hcr.Row).ClearContents
            Range("E" & Hcr.Row).ClearContents
            Range("F" & Hcr.Row).ClearContents
            Range("G" & Hcr.Row).ClearContents
            Range("H" & Hcr.Row).ClearContents
            Range("I" & Hcr.Row).ClearContents
            Range("J" & Hcr.Row).ClearContents
            Range("K" & Hcr.Row).ClearContents
            Range("L" & Hcr.Row).ClearContents
            Range("M" & Hcr.Row).ClearContents
            Range("N" & Hcr.Row).ClearContents
        Else
            Range("A" & Hcr.Row) = Range("A" & Hcr.Row - 0)
            'Range("B" & Hcr.Row) = Range("B" & Hcr.Row - 1)
            Range("C" & Hcr.Row) = Range("C" & Hcr.Row - 1)
            'Range("D" & Hcr.Row) = Range("D" & Hcr.Row - 1)
            Range("E" & Hcr.Row) = Range("E" & Hcr.Row - 1)
            Range("F" & Hcr.Row) = Range("F" & Hcr.Row - 1)
            'Range("G" & Hcr.Row) = Range("G" & Hcr.Row - 1)
            'Range("H" & Hcr.Row) = Range("H" & Hcr.Row - 1)
            Range("I" & Hcr.Row) = Range("I" & Hcr.Row - 1)
            Range("J" & Hcr.Row) = Range("J" & Hcr.Row - 1)
            Range("K" & Hcr.Row) = Range("K" & Hcr.Row - 1)
            'Range("L" & Hcr.Row) = Range("L" & Hcr.Row - 1)
            Range("M" & Hcr.Row) = Range("M" & Hcr.Row - 1)
        End If
    Next Hcr
    Application.EnableEvents = True
End Sub
 
Ömer bey yeni birşey fark ettim, kopyalama yaptığı zaman formülü değil sadece değerleri kopyalıyor, Formülle beraber kopyalaması için yapabileceğimiz birşey var mı?
 
Şöyle yol göstersem inanıyorum ki siz yapacaksınız.
C++: 
'F1 deki formülü F2 ye kopyalar
Range("F1").Copy
Range("F2").PasteSpecial Paste:=xlPasteFormulas
 
Sorunuzu eksik sorduğunuz için tam cevaplayamıyorum. Mecburen yol gösteriyorum.
Verdiğim kodların şu bölümü üst satırı alt satıra kopyalıyor. Hangi

C++: 
     Else
            Range("A" & Hcr.Row) = Range("A" & Hcr.Row - 0)
            'Range("B" & Hcr.Row) = Range("B" & Hcr.Row - 1)
            Range("C" & Hcr.Row) = Range("C" & Hcr.Row - 1)
            'Range("D" & Hcr.Row) = Range("D" & Hcr.Row - 1)
            Range("E" & Hcr.Row) = Range("E" & Hcr.Row - 1)
            Range("F" & Hcr.Row) = Range("F" & Hcr.Row - 1)
            'Range("G" & Hcr.Row) = Range("G" & Hcr.Row - 1)
            'Range("H" & Hcr.Row) = Range("H" & Hcr.Row - 1)
            Range("I" & Hcr.Row) = Range("I" & Hcr.Row - 1)
            Range("J" & Hcr.Row) = Range("J" & Hcr.Row - 1)
            Range("K" & Hcr.Row) = Range("K" & Hcr.Row - 1)
            'Range("L" & Hcr.Row) = Range("L" & Hcr.Row - 1)
            Range("M" & Hcr.Row) = Range("M" & Hcr.Row - 1)
        End If

Diyelim ki F sütununuzda formül var.
F50 yi F51 e formül olarak kopyalamak için
'Range("F" & Hcr.Row) = Range("F" & Hcr.Row - 1) yerine

C++: 
Range("F" & Hcr.Row-1).Copy
Range("F" & Hcr.Row).PasteSpecial Paste:=xlPasteFormulas
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst