excel veri aktarımı ile ilgili...

[mehmetkose]

Merhaba arkadaşlar ekte gönderdiğim dosyada gelenler ve gelmeyenler sayfasına koyduğum güncelle butonuna bastığım zaman diğer sayfalardaki ilk sütünlarda GELDİ yazanları komple satır olarak gelenler sayfasına kopyalacak GELMEDİ yazanlarıda GELMEYENLER sayfasına komple satır olarak kopyalacak bir koda ihtiyacım var. Yardımcı olursanız sevinirim.

 

[YUSUF44]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub kopya()
Set s1 = Sheets("RULMANLAR - 1")
Set s2 = Sheets("RULMANLAR - 2")
Set s3 = Sheets("MALZEMELER")
Set s4 = Sheets("GELENLER")
Set s5 = Sheets("GELMEYENLER")

r1 = s1.Cells(Rows.Count, 1).End(3).Row
r2 = s2.Cells(Rows.Count, 1).End(3).Row
m = s3.Cells(Rows.Count, 1).End(3).Row

For i = 2 To r1
    s1.Select
        If s1.Cells(i, "A") = "GELDİ" Then
            yenigelen = s4.Cells(Rows.Count, 1).End(3).Row + 1
            s1.Range(Cells(i, "A"), Cells(i, "F")).Copy s4.Cells(yenigelen, "A")
    
        Else
            yenigelmeyen = s5.Cells(Rows.Count, 1).End(3).Row + 1
            s1.Range(Cells(i, "A"), Cells(i, "F")).Copy s5.Cells(yenigelmeyen, "A")
        End If
Next

For i = 2 To r2
    s2.Select
        If s2.Cells(i, "A") = "GELDİ" Then
            yenigelen = s4.Cells(Rows.Count, 1).End(3).Row + 1
            s2.Range(Cells(i, "A"), Cells(i, "F")).Copy s4.Cells(yenigelen, "A")
    
        Else
            yenigelmeyen = s5.Cells(Rows.Count, 1).End(3).Row + 1
            s2.Range(Cells(i, "A"), Cells(i, "F")).Copy s5.Cells(yenigelmeyen, "A")
        End If
Next

For i = 2 To m
    s3.Select
        If s3.Cells(i, "A") = "GELDİ" Then
            yenigelen = s4.Cells(Rows.Count, 1).End(3).Row + 1
            s3.Range(Cells(i, "A"), Cells(i, "F")).Copy s4.Cells(yenigelen, "A")
    
        Else
            yenigelmeyen = s5.Cells(Rows.Count, 1).End(3).Row + 1
            s3.Range(Cells(i, "A"), Cells(i, "F")).Copy s5.Cells(yenigelmeyen, "A")
        End If
Next

MsgBox ("İşlem Tamam")

End Sub

 

[ykandaz]

merhaba arkadaşlar elimde
AKY-1234 / FYZ-20141234
AKY-1896 / FYZ-2014001896
AKY-54 / AKY-54
CC-236 / CC -201400236

örnekte olduğu gibi düzensiz bir liste var benim amacım slaştan sonrası gibi bir liste oluşturmak bu arada slaştan sonra ki liste elimde var olan bir liste. bu listeye göre düzensiz olan listeyi düzenlemek.

yapmam mümkün müdür?

 

[Ömer]

Merhaba,

İstediğiniz net değil. Tahmin yürüterek;

Verileri A sütununda olsun, A sütunu fare ile seçin, Veri sekmesinden / metni sütunlara dönüştür / ekrandaki "sınırlandırılmış" kalsın ve ileri tuşuna basın, açılan ekranda "diğer" sekmesini işaretleyip yan bölümündeki kutusuna / işareti yazın ve ileri tuşuyla devam ederek tamam ile işlemi bitirin.

Not: Farklı konuyla ilgili sorularınız için yeni konu başlığı açmanızı rica ederim.

.

 

[mehmetkose]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub kopya()
Set s1 = Sheets("RULMANLAR - 1")
Set s2 = Sheets("RULMANLAR - 2")
Set s3 = Sheets("MALZEMELER")
Set s4 = Sheets("GELENLER")
Set s5 = Sheets("GELMEYENLER")

r1 = s1.Cells(Rows.Count, 1).End(3).Row
r2 = s2.Cells(Rows.Count, 1).End(3).Row
m = s3.Cells(Rows.Count, 1).End(3).Row

For i = 2 To r1
    s1.Select
        If s1.Cells(i, "A") = "GELDİ" Then
            yenigelen = s4.Cells(Rows.Count, 1).End(3).Row + 1
            s1.Range(Cells(i, "A"), Cells(i, "F")).Copy s4.Cells(yenigelen, "A")
    
        Else
            yenigelmeyen = s5.Cells(Rows.Count, 1).End(3).Row + 1
            s1.Range(Cells(i, "A"), Cells(i, "F")).Copy s5.Cells(yenigelmeyen, "A")
        End If
Next

For i = 2 To r2
    s2.Select
        If s2.Cells(i, "A") = "GELDİ" Then
            yenigelen = s4.Cells(Rows.Count, 1).End(3).Row + 1
            s2.Range(Cells(i, "A"), Cells(i, "F")).Copy s4.Cells(yenigelen, "A")
    
        Else
            yenigelmeyen = s5.Cells(Rows.Count, 1).End(3).Row + 1
            s2.Range(Cells(i, "A"), Cells(i, "F")).Copy s5.Cells(yenigelmeyen, "A")
        End If
Next

For i = 2 To m
    s3.Select
        If s3.Cells(i, "A") = "GELDİ" Then
            yenigelen = s4.Cells(Rows.Count, 1).End(3).Row + 1
            s3.Range(Cells(i, "A"), Cells(i, "F")).Copy s4.Cells(yenigelen, "A")
    
        Else
            yenigelmeyen = s5.Cells(Rows.Count, 1).End(3).Row + 1
            s3.Range(Cells(i, "A"), Cells(i, "F")).Copy s5.Cells(yenigelmeyen, "A")
        End If
Next

MsgBox ("İşlem Tamam")

End Sub

kod için teşekkür ederim arkadaşım, bir sorum daha olacak affınıza sığınarak, peki aynı kitap içerisinde çok sayıda sayfa mevcut ve sürekli yeni sayfa ekleniyor bu sayfalara, bunlar içerisinden nasıl seçip taşıtabilirim?

 

[YUSUF44]

kod için teşekkür ederim arkadaşım, bir sorum daha olacak affınıza sığınarak, peki aynı kitap içerisinde çok sayıda sayfa mevcut ve sürekli yeni sayfa ekleniyor bu sayfalara, bunlar içerisinden nasıl seçip taşıtabilirim?

Kusura bakmayın, iş yoğunluğu nedeniyle uzun süredir siteye giremiyordum, sorunuzu yeni gördüm. aşağıdaki kodları bir modüle kopyalayıp denerseniz, dosyada bulunan bütün sayfalardaki verileri GELENLER ve GELMEYENLER sayfasına aktarır (GELENLER ve GELMEYENLER sayfaları hariç tabi )

Sub kopya()
Set s4 = Sheets("GELENLER")
Set s5 = Sheets("GELMEYENLER")
For sayfa = 1 To Sheets.Count
    If Sheets(sayfa).Name <> "GELENLER" Or Sheets(sayfa).Name <> "GELMEYENLER" Then
        r1 = Sheets(sayfa).Cells(Rows.Count, 1).End(3).Row
        For i = 2 To r1
            Sheets(sayfa).Select
            If Sheets(sayfa).Cells(i, "A") = "GELDİ" Then
                yenigelen = s4.Cells(Rows.Count, 1).End(3).Row + 1
                Sheets(sayfa).Range(Cells(i, "A"), Cells(i, "F")).Copy s4.Cells(yenigelen, "A")
            Else
                yenigelmeyen = s5.Cells(Rows.Count, 1).End(3).Row + 1
                Sheets(sayfa).Range(Cells(i, "A"), Cells(i, "F")).Copy s5.Cells(yenigelmeyen, "A")
            End If
        Next
    End If
Next
MsgBox ("İşlem Tamam")
End Sub