Makro ile belirli hücre arasını kopyalama

[maskex]

Merhabalar Sevgili Dostlar,

Ekteki dosyam içerisinde geçmiş gerçekleşen veriler ile gelecek verileri takip ediyorum. Yapmak istediğim aşağıdaki gibi. Summary sayfasında D3 sütunu Today -1 olarak tarih gösteriyor. Bir makro oluşturup butona tıklayarak, Summary sayfasında D8:N39 satırları arasında D3 satırında yazılı tarihle ile işleşen hücreyi ve o hücrenin sağı ve altındaki tüm hücleri seçip kopyalamak.

Kopyalanan bu değerleri Yedek sayfasına yapıştırmak. Ama yapıştırırken yine Summary sayfasında D3 te yazan tarihi yedek sayfasında bulacak ve o tarihi seçerek yapıştıracak. Makroda belli bir tarihi bul, bulunan hücrenin sağa ve aşağıya doğru dolu hücreleri seç fonksiyonunu yapamadığım için dosyayı yapamadım. Yardımcı olursanız çok mutlu olurum.

Sevgiler & Saygılar

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu kullanabilirsiniz.
Örnekte "Yedek" sayfasındaki tarihler ile "Summary" sayfasındaki tarihlerin satırları aynı görünüyor. Onun için "Yedek" sayfasında arama yapmadan aynı satıra yapıştırma yaptım. Eğer iki sayfadaki tarihlerin bulunduğu satır değişiyorsa kodda değişiklik yapmak lazım.

Sub Kopyala()
    Dim Aranan As Date
    Dim Bulunan As Integer
    Aranan = Range("D3")
    Bulunan = Range("D9:D39").Find(Aranan).Row
    Range("D" & Bulunan & ":N39").Copy Worksheets("Yedek").Range("D" & Bulunan)
End Sub

 

[maskex]

Merhaba.
Aşağıdaki kodu kullanabilirsiniz.
Örnekte "Yedek" sayfasındaki tarihler ile "Summary" sayfasındaki tarihlerin satırları aynı görünüyor. Onun için "Yedek" sayfasında arama yapmadan aynı satıra yapıştırma yaptım. Eğer iki sayfadaki tarihlerin bulunduğu satır değişiyorsa kodda değişiklik yapmak lazım.

Sub Kopyala()
    Dim Aranan As Date
    Dim Bulunan As Integer
    Aranan = Range("D3")
    Bulunan = Range("D9:D39").Find(Aranan).Row
    Range("D" & Bulunan & ":N39").Copy Worksheets("Yedek").Range("D" & Bulunan)
End Sub

Hızlı cevabınız ve yardımınız için çok teşekkürler.

Yedek sayfasında tarihler değişebilir o sebeple tarih araması yapması çok önemli. 2. önemli konu ise Summary sayfasındaki tarih aşağıya doğru daha fazla devam edebilir, dolayısı ile formülü D39 veya N39 ile sınırlamayıp aşağıya doğru dolu tüm hücreleri seçecek şekilde kodyalabilir miyiz ?

Yardımlarınız için minnettarım.

Sevgiler,

 

[Muzaffer Ali]

O zaman aşağıdaki kodları deneyin.

Sub Kopyala()
    Dim Aranan As Date
    Dim SonSatirSum As Integer
    Dim BulunanSum As Integer
    Dim BulunanYedek As Integer
    Aranan = Range("D3")
    BulunanSum = Range("D9:D" & Rows.Count).Find(Aranan).Row
    SonSatirSum = Cells(Rows.Count, "D").End(xlUp).Row
    With Worksheets("Yedek")
        BulunanYedek = .Range("D9:D" & Rows.Count).Find(Aranan).Row
        Range("D" & BulunanSum & ":N" & SonSatirSum).Copy .Range("D" & BulunanYedek)
    End With
End Sub

 

[maskex]

O zaman aşağıdaki kodları deneyin.

Sub Kopyala()
    Dim Aranan As Date
    Dim SonSatirSum As Integer
    Dim BulunanSum As Integer
    Dim BulunanYedek As Integer
    Aranan = Range("D3")
    BulunanSum = Range("D9:D" & Rows.Count).Find(Aranan).Row
    SonSatirSum = Cells(Rows.Count, "D").End(xlUp).Row
    With Worksheets("Yedek")
        BulunanYedek = .Range("D9:D" & Rows.Count).Find(Aranan).Row
        Range("D" & BulunanSum & ":N" & SonSatirSum).Copy .Range("D" & BulunanYedek)
    End With
End Sub

Hocam hata verdi. Ayrıca kopyalanan verileri Yedek sayfasına yapıştırırken Value olarak yapıştırması gerekiyor.

 

[Muzaffer Ali]

Aşağıdaki kodları kullanın.

Sub Kopyala()
    Dim Aranan As Date
    Dim SonSatirSum As Integer
    Dim BulunanSum As Range
    Dim BulunanYedek As Range
    If Not IsDate(Range("D3")) Then
        MsgBox "'Summary' sayfası 'D3' hücresinde bulunan değer tarih olmalıdır. Lütfen kontrol ederek yeniden deneyiniz."
        Exit Sub
    End If
    Aranan = Range("D3")
    Set BulunanSum = Range("D9:D" & Rows.Count).Find(Aranan)
    If BulunanSum Is Nothing Then
        MsgBox "Aradığınız tarih: " & Aranan & " 'Summary' sayfasında bulunamıyor."
        Exit Sub
    End If
    SonSatirSum = Cells(Rows.Count, "D").End(xlUp).Row
    With Worksheets("Yedek")
        Set BulunanYedek = .Range("D9:D" & Rows.Count).Find(Aranan)
        If BulunanYedek Is Nothing Then
            MsgBox "Aradığınız tarih: " & Aranan & " 'Yedek' sayfasında bulunamıyor."
            Exit Sub
        End If
        Range("D" & BulunanSum.Row & ":N" & SonSatirSum).Copy
        .Range("D" & BulunanYedek.Row).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End With
End Sub

 

[ottoman005]

=SAYFA1! D35 KULLANIP C34 TEKİ VERİYİ D35 YAZDIRIYORUM ALT ÇAPRAZA BUNUN MAKRO KODU HAKKINDA YARDIMCI OLURSANIZ SEVINIRIM SAYFA1 YANİ SAYFA ADINI ŞİMDİLİK SAYFA 1 YAZDIM AMA SONRA DEĞİŞTİRMEM GEREKECEK MAKRODA SAYFA Adı VEYA HüCRE ISTEGE GÖRE degiştirilir şekilde olursa çok makbule geçer şimdiden teşekkürler