Soru Makro ile kopyala yapıştır kaydet.

[diablus]

Merhabalar. Excelde günlük görevlendirme yapmis oldugum ismi sayfa1 olan bir tablom var. Tabloda gorevi olan isimler A1 İle A10 arasinda yer aliyor. Ben makro ile butona bastığımda A1 ile A10 arasindaki isimleri sayfa2 isimli sayfanın A sütununa kaydetmesini istiyorum. Ancak burada önemli olan hergün kayıt yapacağım için butona bastığımda isimleri sayfa2 nin A sütunundaki dolu hucrenin altindan kaydetmeye baslamasini istiyorum. Amacım günlük goreve gidinlerin isimlerini sayfa 2 de kayıt altina almak ve bir veritabani oluşturmak. Ornegin bugün 10 isim kaydettim sayfa 2 A1 ile A10 arasina kaydetti. Yarın tekrar kaydettigimde A11 ile A 20 arasina kaydetmesi lazim ve bu sekilde gitmesi gerekiyor.

 

[volki_112]

Merhabalar. Excelde günlük görevlendirme yapmis oldugum ismi sayfa1 olan bir tablom var. Tabloda gorevi olan isimler A1 İle A10 arasinda yer aliyor. Ben makro ile butona bastığımda A1 ile A10 arasindaki isimleri sayfa2 isimli sayfanın A sütununa kaydetmesini istiyorum. Ancak burada önemli olan hergün kayıt yapacağım için butona bastığımda isimleri sayfa2 nin A sütunundaki dolu hucrenin altindan kaydetmeye baslamasini istiyorum. Amacım günlük goreve gidinlerin isimlerini sayfa 2 de kayıt altina almak ve bir veritabani oluşturmak. Ornegin bugün 10 isim kaydettim sayfa 2 A1 ile A10 arasina kaydetti. Yarın tekrar kaydettigimde A11 ile A 20 arasina kaydetmesi lazim ve bu sekilde gitmesi gerekiyor.

Bu kodu sayfanin genel kod bolumune veya module e yaziniz. Daha sonra bir buton ekleyin. Butona sag tiklayip makro ata deyin. Bu makroyu secin. Bastiginizda istediginiz islem olur artik

Sub GorevlendirilenleriKaydet()

    Dim kaynakSayfa As Worksheet
    Dim hedefSayfa As Worksheet
    Dim sonSatir As Long
    Dim i As Long

    ' Kaynak ve hedef sayfaları tanımla
    Set kaynakSayfa = ThisWorkbook.Sheets("Sayfa1")
    Set hedefSayfa = ThisWorkbook.Sheets("Sayfa2")

    ' Hedef sayfadaki A sütunundaki son dolu satırı bul
    On Error Resume Next ' Hata durumunda bir sonraki satıra geç
    sonSatir = hedefSayfa.Cells(Rows.Count, "A").End(xlUp).Row
    On Error GoTo 0    ' Hata yakalamayı kapat

    ' Eğer hedef sayfada hiç veri yoksa, ilk satırdan başla
    If sonSatir < 1 Then
        sonSatir = 1
    Else
        ' Son dolu satırın bir altından başlayacak şekilde ayarla
        sonSatir = sonSatir + 1
    End If

    ' Kaynak sayfadaki isimleri hedef sayfaya kopyala
    For i = 1 To 10
        Dim isim As String
        isim = Trim(kaynakSayfa.Cells(i, "A").Value) ' Hücredeki değeri al ve boşlukları temizle
        If isim <> "" Then ' Eğer hücre boş değilse kaydet
            hedefSayfa.Cells(sonSatir, "A").Value = isim
            sonSatir = sonSatir + 1
        End If
    Next i

    MsgBox "Görevlendirilen isimler Sayfa2'ye kaydedildi.", vbInformation

End Sub

 

[diablus]

Bu kodu sayfanin genel kod bolumune veya module e yaziniz. Daha sonra bir buton ekleyin. Butona sag tiklayip makro ata deyin. Bu makroyu secin. Bastiginizda istediginiz islem olur artik

Sub GorevlendirilenleriKaydet()

    Dim kaynakSayfa As Worksheet
    Dim hedefSayfa As Worksheet
    Dim sonSatir As Long
    Dim i As Long

    ' Kaynak ve hedef sayfaları tanımla
    Set kaynakSayfa = ThisWorkbook.Sheets("Sayfa1")
    Set hedefSayfa = ThisWorkbook.Sheets("Sayfa2")

    ' Hedef sayfadaki A sütunundaki son dolu satırı bul
    On Error Resume Next ' Hata durumunda bir sonraki satıra geç
    sonSatir = hedefSayfa.Cells(Rows.Count, "A").End(xlUp).Row
    On Error GoTo 0    ' Hata yakalamayı kapat

    ' Eğer hedef sayfada hiç veri yoksa, ilk satırdan başla
    If sonSatir < 1 Then
        sonSatir = 1
    Else
        ' Son dolu satırın bir altından başlayacak şekilde ayarla
        sonSatir = sonSatir + 1
    End If

    ' Kaynak sayfadaki isimleri hedef sayfaya kopyala
    For i = 1 To 10
        Dim isim As String
        isim = Trim(kaynakSayfa.Cells(i, "A").Value) ' Hücredeki değeri al ve boşlukları temizle
        If isim <> "" Then ' Eğer hücre boş değilse kaydet
            hedefSayfa.Cells(sonSatir, "A").Value = isim
            sonSatir = sonSatir + 1
        End If
    Next i

    MsgBox "Görevlendirilen isimler Sayfa2'ye kaydedildi.", vbInformation

End Sub

Hocam kod ilk çalışmasında kaydediyor. ancak ikinci tuşlamamda aynı isimleri kaydetmiyor. ben aynı isimler varsa onlarında kaydolmasını istiyorum. ayrıca A sütununda bazı hücrelerde boşluk var. boşluktan sonraki isimleri de kaydetmiyor. sadece peşpeşe olan isimleri kaydediyor. teşekkürler

 

[volki_112]

Hocam kod ilk çalışmasında kaydediyor. ancak ikinci tuşlamamda aynı isimleri kaydetmiyor. ben aynı isimler varsa onlarında kaydolmasını istiyorum. ayrıca A sütununda bazı hücrelerde boşluk var. boşluktan sonraki isimleri de kaydetmiyor. sadece peşpeşe olan isimleri kaydediyor. teşekkürler

dosya.tc dosya.co gibi sitelere örnek dosyanızı yükleyip buraya link veriniz. dosya üzerinde çalışmak daha sağlıklı olur.

 

[pitchoute]

Merhaba, deneyip sonucu paylaşabilir misiniz;

Sub KisiKaydet()
    Dim sonSatir As Long
    Dim kaynak As Range
    Dim hedef As Range
    
    Set kaynak = Worksheets("Sayfa1").Range("A1:A10")
    sonSatir = Worksheets("Sayfa2").Cells(Worksheets("Sayfa2").Rows.Count, "A").End(xlUp).Row
    
    If Application.CountA(Worksheets("Sayfa2").Range("A:A")) = 0 Then
        sonSatir = 0
    End If

    Set hedef = Worksheets("Sayfa2").Range("A" & sonSatir + 1)
    kaynak.Copy hedef
    MsgBox "Kişiler başarıyla kaydedildi!", vbInformation
    ThisWorkbook.Save
End Sub