İstenilen kadar sütun açarak verileri yazsın

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar; elimde bir PUANTAJ adlı sayfam var, bu sayfaya hızlıca ekleme ve silme işlemini yapmak istiyorum yardımcı olursanız sevinirim. Sorum şöyle
PUANTAJ sayfamın AU ile AY arasına almış olduğum personeli AY kolonunda "VERİLECEK" olanları (kaç tane ise) ASIL puantaj listemin B sütunun en son dolu satırına satır eklemek suretiyle getirmesini istiyorum, satır eklemesini şunun için istiyorum, tablomun altında işlem yapan personelin isimleri olduğu için. Not: Başlıkdaki sütun satır olacak "İstenilen kadar satır açarak verileri yazsın"
Teşekkürler.

 

[Hacı Bayram ÖZKAN]

Selamüm Aleyküm benim konu bakabilir misiniz teşekkürler

 

[mancubus]

Sub xlTR_196523_alta_satir_ekle_filtre_alan_kopyala()
  
    Dim IlkBSat As Long
    Dim veri
    
    With Worksheets("PUANTAJ")
        IlkBSat = Range("B" & Rows.Count).End(xlUp).Offset(1).Row 'B sütununun ilk boş satırı
    
        With .Range("AU6").CurrentRegion
            .AutoFilter Field:=5, Criteria1:="VERİLECEK"
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy .Parent.Cells(1, 200)
            .AutoFilter
        End With
    
        veri = .Cells(1, 200).CurrentRegion.Resize(, 4).Value
        .Cells(1, 200).CurrentRegion.Clear

        .Rows(IlkBSat).Resize(UBound(veri, 1)).Insert
        .Range("B" & IlkBSat).Resize(UBound(veri, 1), UBound(veri, 2)).Value = veri
        
        With .Range("A" & IlkBSat).Resize(UBound(veri, 1), 1)
            .Formula = "=Row()-6"
            .Value = .Value
        End With
    
    End With

End Sub

 

[Hacı Bayram ÖZKAN]

Sayın abim unutuldu sanmıştım, ama yanılmışım çok teşekkür ederim. Eline sağlık uğraşmışsınız ama, kodu çalıştırdığımda hiç bir hücre bulunamadı diyor, ve .Offset(1).SpecialCells(xlCellTypeVisible).Copy .Parent.Cells(1, 200) bu satır sarı yanıyor.

 

[mancubus]

Merhaba. Rica ederim.
Yüklenen dosyada test ettikten sonra kodu göndermiştim.
ilk fırsatta daha farklı bir şekilde çalışıp göndereyim.

 

[Hacı Bayram ÖZKAN]

Sayın abim gerek kalmadı, sayın PLİNT özelden yazdı. Teşekkür ederim. hepiniz de eksik olmayın. İyi ki varsınız?

 

[mancubus]

1004 hücre bulunamadı hatası AY sütununda filtre kriterine uyan kayıt olmadığı anlamına gelir. veri başka yerden kopyalanıyorsa başında sonunda görünmeyen karakterler olabilir. onu kontrol etmekte fayda var.
bu arada açıklamalaı bir kod yazdım. sütunda kritere uyan veri yoksa makroyu sonlandıran bir satır ekledim. onu göndereyim.

 

[mancubus]

Sub xlTR_196523_alta_satir_ekle_filtre_alan_kopyala()
 
    Dim IlkBSat As Long
    Dim FiltKrit, veri
       
    FiltKrit = "VERİLECEK"
   
    With Worksheets("PUANTAJ")
        .AutoFilterMode = False 'sayfada filtre uygulanmışsa kaldır
       
        IlkBSat = .Range("B" & .Rows.Count).End(xlUp).Offset(1).Row 'B sütununun ilk boş satırı
       
        If Application.CountIf(.Range("AY:AY"), FiltKrit) = 0 Then
            MsgBox "AY sütununda filtreleme kriterine uyan kayıt bulunmamaktadır. Makro sonlandırılıyor.", vbOKOnly
            Exit Sub
        End If
        'kritere uyan satır yoksa makroyu sonlandır.
       
        With .Range("AU6").CurrentRegion
            .AutoFilter Field:=5, Criteria1:=FiltKrit
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy .Parent.Cells(1, 200)
            'Filtre alanını GR1 hücresinden başlayarak kopyala
            .Parent.AutoFilterMode = False
            'uygulanan filtreyi sayfadan kaldır
        End With
   
        veri = .Cells(1, 200).CurrentRegion.Resize(, 4).Value
        'kopyalanmış alanı dizi değişkenine ata
        .Cells(1, 200).CurrentRegion.Clear
        'kopyalanmış alanı sil

        .Rows(IlkBSat).Resize(UBound(veri, 1)).Insert
        'tablonun altına dizi değişkenindeki satır sayısı kadar boş satır ekle
        .Range("B" & IlkBSat).Resize(UBound(veri, 1), UBound(veri, 2)).Value = veri
        'dizi değişkenindeki verileri B sütunundan başlayarak sayfaya yaz
       
        With .Range("A" & IlkBSat).Resize(UBound(veri, 1), 1)
            .Formula = "=Row()-6"
            .Value = .Value
        End With
        'A sütununa sıra no ekle. 1 sıra numaralı verinin satır numarası 7. demek ki SATIR NO - 6 formülünü sıra no vermek için kullanabiliriz.
    End With

End Sub

 

[Hacı Bayram ÖZKAN]

Sayın abim çok teşekkür ederim zahmet verdim, eline sağlık.