Hücredeki veriye bakarak kopyalama

[andon]

Merhaba,
Ekte ki dosyamda bulunan excell tablosunun "ana" isimli sekmesinde bulunan verileri, "veri_deb" sekmesinde makro kodları ile belirttiğim alanlara kopyalıyorum.
Sizlerden yardım talebime konu ise; belirttiğim kodlara göre kopyalama yaparken "ana" sekmesi "L" sütununda bulunan veriler "veri_deb" sekmesine kopyalanmasın ama verilerde "ANKARA" var ise "veri_deb" sekmesinin "F" sütununda ilgili kişinin karşısında ki sütuna "ANKARA" yazdırılsın.
Teşekkür ederim

 

[andon]

Merhaba,
Ekte ki dosyamda bulunan excell tablosunun "ana" isimli sekmesinde bulunan verileri, "veri_deb" sekmesinde makro kodları ile belirttiğim alanlara kopyalıyorum.
Sizlerden yardım talebime konu ise; belirttiğim kodlara göre kopyalama yaparken "ana" sekmesi "L" sütununda bulunan veriler "veri_deb" sekmesine kopyalanmasın ama verilerde "ANKARA" var ise "veri_deb" sekmesinin "F" sütununda ilgili kişinin karşısında ki sütuna "ANKARA" yazdırılsın.
Teşekkür ederim

yardımcı olacak kimse yok mu

 

[andon]

Merhaba,
Ekte ki dosyamda bulunan excell tablosunun "ana" isimli sekmesinde bulunan verileri, "veri_deb" sekmesinde makro kodları ile belirttiğim alanlara kopyalıyorum.
Sizlerden yardım talebime konu ise; belirttiğim kodlara göre kopyalama yaparken "ana" sekmesi "L" sütununda bulunan veriler "veri_deb" sekmesine kopyalanmasın ama verilerde "ANKARA" var ise "veri_deb" sekmesinin "F" sütununda ilgili kişinin karşısında ki sütuna "ANKARA" yazdırılsın.
Teşekkür ederim

gerçekten kimse görmüyor mu

 

[YUSUF44]

Aşağıdaki gibi deneyin:

 Sub Kod()
Application.ScreenUpdating = False
Set veri_aktarma = ThisWorkbook.Sheets("veri_deb") 'Hangi sayfaya alınacak?
Set ana = ThisWorkbook.Sheets("ana") 'hangi sayfadan alınacak?
     Sheets("ana").Range("A2:A65000").Copy veri_aktarma.Range("A2")
     Sheets("ana").Range("O2:O65000").Copy veri_aktarma.Range("B2")
     Sheets("ana").Range("O2:O65000").Copy veri_aktarma.Range("C2")
     Sheets("ana").Range("D2:D65000").Copy veri_aktarma.Range("D2")
     Sheets("ana").Range("E2:E65000").Copy veri_aktarma.Range("E2")
     Sheets("ana").Range("L2:L65000").Copy veri_aktarma.Range("F2")
     son = veri_aktarma.Cells(Rows.Count, "F").End(3).Row
     For i = 2 To son
        If veri_aktarma.Cells(i, "F") <> "ANKARA" Then
            veri_aktarma.Cells(i, "F") = ""
        End If
    Next
Application.ScreenUpdating = True
End Sub

 

[andon]

Aşağıdaki gibi deneyin:

 Sub Kod()
Application.ScreenUpdating = False
Set veri_aktarma = ThisWorkbook.Sheets("veri_deb") 'Hangi sayfaya alınacak?
Set ana = ThisWorkbook.Sheets("ana") 'hangi sayfadan alınacak?
     Sheets("ana").Range("A2:A65000").Copy veri_aktarma.Range("A2")
     Sheets("ana").Range("O2:O65000").Copy veri_aktarma.Range("B2")
     Sheets("ana").Range("O2:O65000").Copy veri_aktarma.Range("C2")
     Sheets("ana").Range("D2:D65000").Copy veri_aktarma.Range("D2")
     Sheets("ana").Range("E2:E65000").Copy veri_aktarma.Range("E2")
     Sheets("ana").Range("L2:L65000").Copy veri_aktarma.Range("F2")
     son = veri_aktarma.Cells(Rows.Count, "F").End(3).Row
     For i = 2 To son
        If veri_aktarma.Cells(i, "F") <> "ANKARA" Then
            veri_aktarma.Cells(i, "F") = ""
        End If
    Next
Application.ScreenUpdating = True
End Sub

Yusuf bey teşekkür ederim,
verileri "ana" isimli sayfadan alıyoruz ya, devamında ekte de gönderdiğim gibi "ana2" isimli bir sayfamız daha olsa ve "ana" isimli sayfadaki verileri aktarmasının ardından sırayla "ana2" sayfasında ki veriler de "veri_deb" sayfasına boş hücreden devam etse.
Teşekkür ederim,

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Sub aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("veri_deb") 'Hangi sayfaya alınacak?
Set s2 = Sheets("ana")
Set s3 = Sheets("ana2")
son1 = s2.Cells(Rows.Count, "A").End(3).Row
son2 = s2.Cells(Rows.Count, "A").End(3).Row

uyarı = MsgBox("veri_deb sayfasındaki eski veriler silinsin mi?", vbYesNo)

If uyarı = vbYes Then
    eski = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)
    s1.Range("A2:F" & eski) = ClearContents
End If

yeni1 = s1.Cells(Rows.Count, "A").End(3).Row + 1

s2.Range("A2:A" & son1).Copy s1.Cells(yeni1, "A")
s2.Range("O2:O" & son1).Copy s1.Cells(yeni1, "B")
s2.Range("O2:O" & son1).Copy s1.Cells(yeni1, "C")
s2.Range("D2:D" & son1).Copy s1.Cells(yeni1, "D")
s2.Range("E2:E" & son1).Copy s1.Cells(yeni1, "E")
s2.Range("L2:L" & son1).Copy s1.Cells(yeni1, "F")

yeni2 = s1.Cells(Rows.Count, "A").End(3).Row + 1

s3.Range("A2:A" & son2).Copy s1.Cells(yeni2, "A")
s3.Range("O2:O" & son2).Copy s1.Cells(yeni2, "B")
s3.Range("O2:O" & son2).Copy s1.Cells(yeni2, "C")
s3.Range("D2:D" & son2).Copy s1.Cells(yeni2, "D")
s3.Range("E2:E" & son2).Copy s1.Cells(yeni2, "E")
s3.Range("L2:L" & son2).Copy s1.Cells(yeni2, "F")

son = s1.Cells(Rows.Count, "F").End(3).Row
    For i = 2 To son
        If s1.Cells(i, "F") <> "ANKARA" Then
            s1.Cells(i, "F") = ""
        End If
    Next
Application.ScreenUpdating = True
End Sub

 

[andon]

Yusuf Bey,
Gerçekten minnettar oldum. Fazlasıyla işimi gördüm. Konuyla alakalı bir kaç sorum daha olabilir. Gelişitmryi düşünüyorum da biraz daha. Çok sıkışırsam sie döneceğim.
Teşekkür ederim, iyi çalışmalar,