• DİKKAT

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

Son boş hücre. Tanımını ekleme.

Katılım
7 Ekim 2013
Mesajlar
169
Excel Vers. ve Dili
2003 TR
Merhabalar,

Aşağıda ki kod her seferinde,

"B" sütununun en son boş hücresine verileri değer olarak yapıştırsın istiyorum.

Diğer herşey aynı kalacak. Değerli yardımlarınızı bekliyorum. Teşekkür ederim.


Sub Makro1()
Sheets("Data").Select
Range("A2:C12").Select
Selection.Copy
Sheets("Çalışma").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
 
Merhaba,

Kodlardan anladığım kadarıyla Data sayfasının A2:C12 aralığını Çalışma sayfasının B2 hücresine kopyalıyor.

B sütunun son 5 hücresine nasıl kopyalasın ki?

Aslında Şunu mu demek istiyorsunuz : Data sayfasının A sütununun son 5 hücresini Çalışma sayfasının B sütununun sonuna eklesin. mi yoksa ne?
 
Merhabalar Necdet Hocam,


Şu şekilde bir kod istiyorum.

Bulunduğum sayfa "Çalışma" sayfası

Başla:

"Data" sayfasına git

"A2:C12" aralığını kopyala

("Çalışma" sayfasındayız) "B2" den başlamak koşulu ile

B sütununda son boş hücreyi bul

verileri buraya değer olarak yapıştır
 
Merhaba,

Sanırım kavram kargaşası oluşmuş.

"Son boş hücre" ve "Son 5 hücre"

Aşağıdaki kodu deneyiniz.

Kod:
Sub Makro1()
    Dim Satir As Long
    Sheets("Data").Range("A2:C12").Copy
    With Sheets("Çalışma")
        Satir = .Cells(Rows.Count, 2).End(3).Row + 1
        .Cells(Satir, 2).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End With
End Sub
 
Teşekkür ederim Korhan Hocam.

Ellerinize sağlık.


Edit: Sayfa genelinde değer olan en son dolu hücrenin altındaki boş hücreye

gitmek için nasıl bir kod kullanmalıyım acaba?
 
Aşağıdaki kodu kullanabilirsiniz.

Kod:
Sub Sayfada_Son_Hucreye_Git()
    Dim Bul As Range
    Set Bul = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious)
    If Not Bul Is Nothing Then
        Bul.Offset(1, 0).Select
    Else
        MsgBox "Veri bulunamadı!", vbExclamation
    End If
End Sub
 
Kod:
Sub Makro1()
    Dim Satir As Long
    Sheets("Data").Range("A2:C12").Copy
    With Sheets("Çalışma")
        Satir = .Cells(Rows.Count, [COLOR="Blue"][B]2[/B][/COLOR]).End(3).Row + 1
        .Cells(Satir, [B][COLOR="Red"]2[/COLOR][/B]).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End With
End Sub

Özür dilerim. Epey uğraştım lakin düzeltemedim.

Kırmızı ile işaretlediğim 2 gelen verinin hangi sütuna yazılacağının adresi (Koda göre B sütunu)

Mavi ile işaretlediğim 2 nin ise herhangi bir fonksiyonunu göremedim Hocam.

Boş alanı tespit ederken sütunun üstünde birkaç satırı muaf tutmak istiyorum

Ekli dosyaya bakabilirmisiniz acaba?
 

Ekli dosyalar

Bir dediğiniz diğerini tutmuyor böyle yardım isteme olmaz.

Tek yapmanız gereken B5 hücresine bir şey yazmak mesela nokta koyun.

Kod:
Sub Makrom()
    Sayfa2.Range("A2:C12").Copy
    Sayfa1.Range("B65536").End(3)(2, 1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub
 
Neden sorgusuz infaz yapıyorsunuz. Ben kodu belkide 1000 dosyanın
200 sütununda birden kullanacağım.... Hepsine noktamı koymam lazım şimdi?
Kod yazmayı bilmiyoruz ama kodların ne iş yaptığını biliyoruz merak etmeyiniz.

Şayet görür ise Korhan Ayhan Hoca' nın 7 nolu mesajıma yardımını bekliyor olacağım.

Size iyi akşamlar sayın Civan Jack..
 
Sorgusuz infaz yapmıyorum gözlerim görüyor çok şükür.
Ayrıca 1000 dosyanın 200 sütununda kullanamazsınız abartmayın ve unutmayın ki siz ne gönderirseniz ona göre kod yazılır.

Gözleriniz görüyorsa kodların ne iş yaptığını elbette ki biliyorsunuzdur.
Ama hangi satırın ne işe yaradığını bilmiyorsunuz. Daha işin başındasınız verilen kodlara zaman ayırarak bu işi öğrenmeye çalışın derim, o zaman kimseye ihtiyacınız kalmaz ve belki o zaman 1000 dosyanın 200 sütununa hakim olabilirsiniz ki bu çok da zor değil.

Korhan bey'in cevabını ben de merak ediyorum.
 
Kodların arasına bir koşul eklenerek sorun çözülebilir. Aşağıdaki gibi deneyiniz.

Kod:
Sub Makro1()
    Dim Satir As Long
    Sheets("Data").Range("A2:C12").Copy
    With Sheets("Çalışma")
        If WorksheetFunction.CountA(.Range("B6:B" & Rows.Count)) = 0 Then
            Satir = 6
        Else
            Satir = .Cells(Rows.Count, 2).End(3).Row + 1
        End If
        .Cells(Satir, 2).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End With
End Sub
 
Öncelikle çok özür dilerim saygıdeğer hocam.

Sizi gereksiz yere meşgul ettim.

Ben yardımı 3. mesaja bakarak yaptınız zannı ile davrandım.

3. mesajda 2. satırdan başlamak koşulu var idi.

Sütun B nin nosu da 2 olduğu için, işin üstüne de acemiliği ekleyince çorba oldu.

Tekrar teşekkür eder saygılar sunarım.

İyi akşamlar.
 
Bir dediğiniz diğerini tutmuyor böyle yardım isteme olmaz.

Tek yapmanız gereken B5 hücresine bir şey yazmak mesela nokta koyun.


Kod:
Sub Makrom()
    Sayfa2.Range("A2:C12").Copy
    Sayfa1.Range("B65536").End(3)(2, 1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

Madem tek sütunda işiniz vardı, dediğim gibi B5 hücresine nokta koyarak bütün önerilen kodları kullanabilirdiniz.. ;) 1000 dosyalı 200 sütunlu örneği de sonra görürüz artık.
 
Evet mesajlar karıştı. Bende son eklediğiniz dosyaya göre düzenleme yapmıştım.

Neyse sorun değil. 12 nolu mesajımdaki kodun içindeki 6 değerlerini 2 ile değiştirip deneyiniz.
 
Mesele yok Korhan Hocam, 6 değerini bilinçli yazdım.

Yardım isterken bir taraftan da kodları çözmeye çalışıyorum.

B sütunu rakam olarak 2 ile temsil edildiği için dosya hazırlamışken

satır no su 2 olmasın istedim sadece. Neden ve niçinlerin peşindeyim

öğrenmek adına. Fazla bir mesafe kat edemedim ama olsun...

Hayırlı akşamlar.
 
Her bahar aşık olurdum da, kışın olmam ki hiç :) ama günler de bahar gibi, ondan olabilir belki :)

Olabilir, var bir şeyler sanki :lol: :D
Mevsimlerden Sonbahar aylardan Kasım, bu size bir şey hatırlatıyor olmalı. ;)
 
Geri
Üst