• DİKKAT

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

Makro ile Son Satırı Kopyalama

mustafa1205

Altın Üye
Katılım
23 Ekim 2010
Mesajlar
1,436
Excel Vers. ve Dili
Office 2016 / 64 Bit - Türkçe
Ekte örnekte bulunan çalışmam da yapmak istediğim en son dolu satırı bir alt satıra kopyalamak istiyorum.Teşekkürler
 

Ekli dosyalar

Ekte örnekte bulunan çalışmam da yapmak istediğim en son dolu satırı bir alt satıra kopyalamak istiyorum.Teşekkürler
Syn. Mustafa1207;
Ekteki dosyayı inceleyin.
Kod:
Private Sub CommandButton1_Click()

sat = Range("B2:B63563").End(4).Row

For i = 2 To 5

Cells(sat + 1, i) = Cells(sat, i)

Next i

End Sub
 

Ekli dosyalar

Merhaba,

Alternatif olsun. Bu şekilde deneyin.

Kod:
Sub Kopyala()
 
    Dim son As Long
 
    son = Cells(Rows.Count, "B").End(xlUp).Row
    Range("B" & son, "E" & son).Copy Range("B" & son + 1)
 
End Sub

.
 
Elinize sağlık tam olarakda istediğim buydu.Çok teşekkür ederim.
 
Hocam bu soruyu şu şekilde güncellemek istiyorum. Acaba düğmeye bastığımızda kaç adet son satırı kopyalamak istediğimizi soran ve içine rakamı girdiğimizde o kadar altalta kopyalama yapmasını sağlayabilirmiyiz acaba?
 
Hocam bu soruyu şu şekilde güncellemek istiyorum. Acaba düğmeye bastığımızda kaç adet son satırı kopyalamak istediğimizi soran ve içine rakamı girdiğimizde o kadar altalta kopyalama yapmasını sağlayabilirmiyiz acaba?

Bu şekilde deneyin.

Kod:
Sub Kopyala()
 
    Dim son As Long, adet As String
    
    adet = Application.InputBox("Kopya Sayısı", "Satır Kopyalama")
    
    If adet = False Then Exit Sub
    
    son = Cells(Rows.Count, "B").End(xlUp).Row
            
    On Error GoTo atla
    Range("B" & son, "E" & son).Copy Range("B" & son + 1, "B" & son + adet)
    
    Exit Sub
atla:
    MsgBox "Girilen Değeri Kontrol Edin"
     
End Sub
.
 
Hocam ellerine sağlık. Tam istediğim gibi çalışıyor. Ancak malumunuz bu işleri tam bilmediğim için ihtiyaçlar kademe kademe belli oluyor vede bende böyle taksit taksit sormak zorunda kalıyorum. Son olarak verdiğiniz kodu örneğe tatbik ettim vede örneğe de eğer imkanınız olursa yapmak istediğimi örnekte açıklama yapmaya çalıştım.Tekrar ilginiz için teşekkür ediyorum.
 

Ekli dosyalar

Soruyu biraz daha açarmısınız.
 
Yani son satırı kopyalama işlemi genel itibari ile hep 8 adet oluyor vede son satırın içeriğine göre dağıtım planları var ve bu bilgiler bu dağıtım planlarına göre örnekte belirttiğim numaralara göre birimlere gidiyor.Ben 8 adet kopyalama yaptığımda dağıtım planı olarak A yı seçersem A planındaki 8 adet numarayı alsın B yi seçersem b planındaki 8 tane numarayı alıp son satırı kopyalama yaptığım 8 adet satırın yanındaki f sütununa yapıştırsın. Sanırım çok karışık oldu. Olmaz isede canınız sağolsun. Buda oldukça işimi görür.
 
Olur tabiki.

Benim anladığım. InputBox'a ( seçim kutusu) A,B..veri yazacaksınız. Buradaki yazılan değeri tablodan bulup, ilgili sütunu F sütununa kopyalayacak.

O halde ilgili sütunda kaçtane değer varsa B:E arasını da okadar mı kopyalayacak, ve eski kopya sayısı olayı kaklıp işlem yukarıdaki gibi mi olacak.

Birde harf seçimini fare ile hücreden mi yapacaksınız yoksa kutuya yazı ile mi yazıp aratacaksınız.
 
Hocam harf seçimini elle giriş yaparak olacak. Kopya sayısı olarak A planında veya diğerlerinde kaç tane varsa hepsini kopyalayacak. Zaten genel olarak istediğim kopya sayısı ile plan sayısı aynı oluyor
 
Yani sizin ilk anlatımınızdaki gibi olacak hocam
 
Yani sizin ilk anlatımınızdaki gibi olacak hocam

Bu şekilde deneyin.

Kod:
Sub Kopyala()
 
    Dim son As Long, plan As Variant, c As Range, sonk As Long
 
    plan = Application.InputBox("Plan Secin", "Satir Kopyalama")
    If plan = False Then Exit Sub
 
    Set c = Range("G2:J2").Find(plan, LookIn:=xlValues)
 
        If Not c Is Nothing Then
            sonk = Cells(Rows.Count, c.Column).End(xlUp).Row
        Else
            MsgBox "Girilen Değeri Kontrol Edin": Exit Sub
        End If
 
        son = Cells(Rows.Count, "B").End(xlUp).Row
  Range("B" & son, "E" & son).Copy Range("B" & son + 1, "B" & son + sonk - 2)
  Range(Cells(3, c.Column), Cells(sonk + 2, c.Column)).Copy Range("F" & son + 1)
 
End Sub
.
 
Hocam ellerine sağlık çok teşekkür ediyorum. Tam istediğim gibi olmuş. İlgi ve alakanız için tekrar çok teşekkür ediyorum
 
Geri
Üst