Veri aktarma makrosu

[Zahir]

Merhabalar;

Muhtemelen bu tür bir soru sorulmuş ve cevabıda verilmiştir ama ben arama yolu ile rastlayamadım. Burda basitleştirilmiş bir örnek var. Ben yardım ederseniz eğer, bu makroları kullanarak oluşturacağım gelir-gider sayfaları ile nakliye araçlarının gelir giderlerini listeleyerek raporlamaya çalışacağım. Amacaım sayfa2'deki şarta uyan, sayfa1'deki verileri sayfa2'ye aktarmak. Bildiğiniz cevabı verilmiş benzer örnek linkler varsa da üzerinde çalışabilirim. Yardımlarınız için şimdiden teşekkürler.

 

[Necdet]

Merhaba.

Benzer çok soruya yanıt verilmiştir forumda ama koşullar farklı olabilir. Aşağıdaki kodları deneyiniz?

Sub Aktar()
    Dim i       As Long, _
        Sat     As Long, _
        Adet    As Long, _
        s1      As Worksheet, _
        s2      As Worksheet, _
        Plaka   As String, _
        BasTar  As Date, _
        BitTar  As Date
 
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("sayfa2")
 
    s2.Select
    BasTar = Range("B1")
    BitTar = Range("B2")
    Plaka = Range("B4")
 
    Sat = Cells(Rows.Count, "A").End(3).Row
    Application.ScreenUpdating = False
 
    For i = 2 To s1.Cells(Rows.Count, "A").End(3).Row
        If s1.Cells(i, "A") >= BasTar And s1.Cells(i, "A") <= BitTar And s1.Cells(i, "B") = Plaka Then
            Sat = Sat + 1
            Adet = Adet + 1
            s1.Range("A" & i & ":F" & i).Copy Cells(Sat, "A")
        End If
    Next i
 
    Application.ScreenUpdating = True
    If Adet = 0 Then
        MsgBox "Koşula Göre Aktarılacak Bilgi Bulamadım....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    Else
        MsgBox Adet & " Adet Koşula Uyan Kayıt Aktarılmıştır...", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    End If
End Sub

 

[Zahir]

Necdet Bey tam olarak istediğim gibi olmuş çok teşekkür ederim elinize sağlık. Diğer yandan arama motorunda bu tür ihtiyacı olanların yararlanması için başlığı ve içeriği bulunabilir kelimelerden seçmeye çalıştım. Umarım kodlarınız benim dışımda da bir çok kişiye yardımcı olur. İyi geceler dilerim.

 

[Zahir]

Merhaba bir konuda takıldım.
Kopyalama işleminde tüm hücreyi değilde sadece değerleri nasıl yapıştırabiliriz.

s1.Range("A" & i & ":F" & i).Copy Cells(Sat, "A")

 

[smmmay]

veri aktarma başka örnek

Merhaba

başta bu fikri veren arkadaşa ve makroyu yazan üstada teşekkürlerimi sunarım.mesaj ekimde yer alan buna benzer fakat biraz değişik çalışmaya makro ile veri taşıması yapabilirmiyiz.ilginiz için şimdiden tekrar teşekkürler.

 

[Zahir]

Buyur bu da benden sana gelsin. Necdet Bey sağolsun epey işimizi gördü. Birde verileri değer olarak yapıştırsak tam olacak çünkü benim kopyalama yaptığım alanlar formül içermekte.

 

[smmmay]

Buyur bu da benden sana gelsin. Necdet Bey sağolsun epey işimizi gördü. Birde verileri değer olarak yapıştırsak tam olacak çünkü benim kopyalama yaptığım alanlar formül içermekte.

çok teşekkürler 10 numara olmuş.

 

[smmmay]

acaba iki tarih arası gibi iki hesap arası koşul konulabilir mi?mesala 720-780 arası gibi.

 

[Zahir]

Çözüm ektedir.

Bu arada kopyalanan alanı değer olarak yapıştıracak makro konusunda bir çözüm sunan henüz olmadı. Küçük projeme noktayı koyamadım gitti

 

[smmmay]

üstad çok sağol.birde yeni koşul nasıl ekliyorsunuz makroya

 

[Zahir]

Aktar butonunu sağ tıkla çıkan menüden makro ata'yı tıkla. Yine çıkan menüden düzenle dedidiğinde o makronun yazılı olduğu modül gelecek karşına. Yani kodların olduğu bölüm. Makro bilgin varsa kodların nasıl yazıldığını bir süre inceleyerek anlayabilirsin. Gerekli yerlerde değişiklik yaparak isteğine göre düzenleyebilirsin. Örneğin orada Hesap2 yazan satırları incele ve son yaptığım ekleme için ne tür değişiklikler yaptığımı anlayabilirsin.

Bu arada kaçıncı kez soruyorum bilmiyorum ama şu kopyalama satırına tümünü değilde yalnızca değerleri yapıştıracak kodu Allah rızası için biri söylesin Yarın arkadaşa kurarız diye söz vermiştim.
s1.Range("A" & i1 & ":B" & i1).Copy Cells(Sat1, "A") // Bu kod tüm hücreyi kopyalıyor. Ben ise sadece değerleri kopyalasın istiyorum.

 

[Zahir]

Arkadaşlar şu soruya bir yardımcı olacak kimse yok mu? Deneyimli arkadaşlar için zor bir soru olmasa gerek.

 

[revelte]

Bu arada kaçıncı kez soruyorum bilmiyorum ama şu kopyalama satırına tümünü değilde yalnızca değerleri yapıştıracak kodu Allah rızası için biri söylesin Yarın arkadaşa kurarız diye söz vermiştim.
s1.Range("A" & i1 & ":B" & i1).Copy Cells(Sat1, "A") // Bu kod tüm hücreyi kopyalıyor. Ben ise sadece değerleri kopyalasın istiyorum.

    Range("A" & i1 & ":B" & i1).Copy
    Range("A" & Sat1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False

 

[Zahir]

revelte çok teşekkür ederim nihayet çözüme kavuştu. Elinize sağlık.

 

[Necdet]

revelte çok teşekkür ederim nihayet çözüme kavuştu. Elinize sağlık.

Merhaba,

Sorunuzu geç gördüm ama yanıtlanmış.
Bende makronun tamamını tekrar ekleyim.

Sub Aktar()
    Dim i       As Long, _
        Sat     As Long, _
        Adet    As Long, _
        s1      As Worksheet, _
        s2      As Worksheet, _
        Plaka   As String, _
        BasTar  As Date, _
        BitTar  As Date
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("sayfa2")
    
    s2.Select
    BasTar = Range("B1")
    BitTar = Range("B2")
    Plaka = Range("B4")
    
    Sat = Cells(Rows.Count, "A").End(3).Row
    Application.ScreenUpdating = False
    
    For i = 2 To s1.Cells(Rows.Count, "A").End(3).Row
        If s1.Cells(i, "A") >= BasTar And s1.Cells(i, "A") <= BitTar And s1.Cells(i, "B") = Plaka Then
            Sat = Sat + 1
            Adet = Adet + 1
            [B][COLOR=red]s1.Range("A" & i & ":F" & i).Copy
            Cells(Sat, "A").PasteSpecial Paste:=xlPasteValues[/COLOR][/B]
        End If
    Next i
    
    Application.ScreenUpdating = True
    [COLOR=red][B]Application.CutCopyMode = False
[/B][/COLOR]    
    If Adet = 0 Then
        MsgBox "Koşula Göre Aktarılacak Bilgi Bulamadım....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr"]www.excel.web.tr[/URL]"
    Else
        MsgBox Adet & " Adet Koşula Uyan Kayıt Aktarılmıştır...", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr"]www.excel.web.tr[/URL]"
    End If
End Sub

 

[gokhankocabas]

Formüllerin değerlerini yapıştırma veri aktar

veri aktar dosyanızdaki verilerin yalnızca değerlerini yapıştırarak aktarma için kodlar düzenlenmiştir.