Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Makro-VBA (http://www.excel.web.tr/forumdisplay.php?f=48)
-   -   Hücre Değerine Göre Farklı Sayfalara Satır Kopyalama (http://www.excel.web.tr/showthread.php?t=169424)

hturkavci03 01-01-2018 20:43

Hücre Değerine Göre Farklı Sayfalara Satır Kopyalama
 
Merhaba, Excel bilgim orta seviyelerde ancak kod seviyem çok düşük. Bir konuda yardıma ihtiyacım var.

Bir Excel çalışma kitabında Sayfa1'de alt alta kayıtlar yapacağım. Bu kayıtları örneğin H sütununda belirleyeceğim 8-10 kadar değerlere göre Sayfa2, Sayfa3.... Sayfa11'de altalta kopyalamak istiyorum.
Kayıtlar yıl içerisinde peyderpey yapılacağından her yani kayıt ilgili sütun değerine göre ilişkili olduğu sayfada kaydın kaldığı yere kopyalanmalı. Yani yapılan kayıtların tümünü Sayfa1'de, H sütunundaki değerlere göre diğer sayfalarda görmem gerekli. Sanırım dosya yükleme yetkim yok, yapamadım. Şimdiden yardımlarınız için teşekkür ederim.

antonio 01-01-2018 21:30

Merhaba,
Forum sayfasına dosya yükleme yetkiniz yok ama "dosya.tc" sitesine yükleme yaparak link verebilirsiniz.

hturkavci03 01-01-2018 21:33

Bunu bilmiyordum. Ayrıca dosya indirme yetkim de yokmuş. Örnek dosya aşağıdaki linktedir.

http://s7.dosya.tc/server/njdqkq/ORNEK.xlsx.html

TanerSaydam 01-01-2018 21:38

Dediğiniz kolayca yapılabilir ama kod yazmak için dosyanızı görmem gerek. Aşağıda istediğiniz şeylerin kodlarını yazıyorum. Kendinize göre düzenleyerek de kullanabilirsiniz.

Sayfa 1'in son satırını bulma
Kod:

Sayfa1.Range("A62652").End(3).Row
Yazdığımız değere göre diğer sayfalara dağılması
NOT: A2'ye 1 yazarsam Sayfa2'ye, 2 yazasam Sayfa3'e değerin son satırın altına yazmasını istersem kodum aşağıdaki gibi olmalı.
Kod:

Private Sub WokSheets_Change (Byval Target As Range)
If Sayfa1.Range("A2").Value = 1 Then
Sayfa2.Range("A" & Sayfa2.Range("A65652").Row +1).Value = Sayfa1.Range("A2").Value
ElseIs Sayfa1.Range("A2").Value = 2 Then
Sayfa2.Range("A" & Sayfa3.Range("A65652").Row +1).Value = Sayfa1.Range("A2").Value
End If

Bu kodda
Kod:

Sayfa2.Range("A65652").Row +1
yazdığım kısım, Sayfa2'deki A'nın son yazılı hücresini bulur ve onun altına veriyi işler.

hturkavci03 01-01-2018 21:48

İlk ve son verdiğiniz kodları hangi olay yordamına ve hangi sayfaya yazmam gerekli acaba.

hturkavci03 01-01-2018 21:56

Bir de koşul sütunu E sütunu ve anladığım kadarıyla değer yazacağım hücre sizin veriğiniz kodlarda A2 olarak sabit. Benim istediğim E sütununda en son yazılan değere göre o satırın kopyalanması.

antonio 01-01-2018 22:00

Merhaba,
Sayfanızın sekmesine sağ tıklayın, "Kod görüntüle" seçin
Açılan kod penceresine aşağıdaki kodları yapıştırın, imleciniz kod satırlarının arasında bir yerlerde iken F5 e tıklayın.
Excel kod arayüzünü biraz kullanmasını biliyorsanız, Ana sayfaya bir düğme çizip sağ tıklayın >> "Makro Ata" seçeneği ile sihirbaz yardımı ile kodu seçin. Böylece düğmeye kod atamış olacaksınız. Kodlarınız aşağıdadır.
Kod:

Sub verilerin_hepsini_getir()
Dim syf As Worksheet, i As Byte, ss As Long, sat As Integer, _
    x As Long, alan As Range, sh As Worksheet

Set sh = Sheets("ANA SAYFA")
sat = 2
sh.Range("A2:E5000").ClearContents
For i = 2 To Sheets.Count
    Set syf = Sheets(i)
    ss = syf.Range("B" & Rows.Count).End(3).Row
    For x = 2 To ss
        Set alan = syf.Range("A" & x & ":E" & x)
        sh.Range("A" & sat).Resize(1, 5).Value = alan.Value
        sat = sat + 1
    Next x
Next i
MsgBox "İşlem tamamlandı..", vbInformation, "antonio"
End Sub


TanerSaydam 01-01-2018 22:03

https://www.dosyaupload.com/5btx

Örnek dosyanız bu. Kullandığım kodlar Aşağıda. Alt+F11 ile kod bölümüne girin. Sayfa1'i çift tıklatın. Orada kodları görebilirsiniz.

Kod:

Sub taşı()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next

son = Range("A65652").End(3).Row



For v = 2 To son
son1 = Sheets("USTA-1").Range("B65652").End(3).Row
son2 = Sheets("USTA-2").Range("B65652").End(3).Row
son3 = Sheets("USTA-3").Range("B65652").End(3).Row
son4 = Sheets("USTA-4").Range("B65652").End(3).Row
If Range("E" & v).Value = "USTA-1" Then
Range("B" & v, "E" & v).Copy
Sheets("USTA-1").Range("B" & son1 + 1).PasteSpecial
Application.CutCopyMode = False
ElseIf Range("E" & v).Value = "USTA-2" Then
Range("B" & v, "E" & v).Copy
Sheets("USTA-2").Range("B" & son2 + 1).PasteSpecial
Application.CutCopyMode = False
ElseIf Range("E" & v).Value = "USTA-3" Then
Range("B" & v, "E" & v).Copy
Sheets("USTA-3").Range("B" & son3 + 1).PasteSpecial
Application.CutCopyMode = False
ElseIf Range("E" & v).Value = "USTA-4" Then
Range("B" & v, "E" & v).Copy
Sheets("USTA-4").Range("B" & son4 + 1).PasteSpecial
Application.CutCopyMode = False
End If
Next v

son1 = Sheets("USTA-1").Range("B65652").End(3).Row
son2 = Sheets("USTA-2").Range("B65652").End(3).Row
son3 = Sheets("USTA-3").Range("B65652").End(3).Row
son4 = Sheets("USTA-4").Range("B65652").End(3).Row

'Sheets("USTA-1").Range("A2:A" & son1).ClearContents
'Sheets("USTA-2").Range("A2:A" & son2).ClearContents
'Sheets("USTA-3").Range("A2:A" & son3).ClearContents
'Sheets("USTA-4").Range("A2:A" & son4).ClearContents

yer = 1
For y = 2 To son1
Sheets("USTA-1").Range("A" & y).Value = yer
yer = yer + 1
Next y

For a = 2 To son2
Sheets("USTA-2").Range("A" & a).Value = a - 1
Next a

For b = 2 To son3
Sheets("USTA-3").Range("A" & b).Value = b - 1
Next b

For c = 2 To son4
Sheets("USTA-4").Range("A" & c).Value = c - 1
Next c


MsgBox "İşlem Başarıyla Tamamlandı.", vbOKOnly + vbInformation, "İŞLEM TAMAMLANDI"
End Sub


hturkavci03 01-01-2018 22:27

Merhaba, ilginize çok teşekkürler.

Sayın TanerSaydam örnek dosyayı inceledim. İşlemi istediğim gibi yapıyor ancak ANA SAYFA'ya yeni kayıt ekleyip (örneğin USTA-4) AKTAR dediğimde önceki kopyalanmış USTA-4 kaydı ile birlikte aktarma yapıyor ve USTA-1 sayfasında mükerrer kayda neden oluyor.

Sayın antonio, verdiğiniz kodları dosyaya uyguladım. Makroyu çalıştırdığımda ANA sayfadaki kayıtlar kayboluyor ve diğer sayfalara kayıt gelmiyor.

antonio 01-01-2018 22:34

Alıntı:

hturkavci03 tarafından gönderildi (Mesaj 924135)
Merhaba, ilginize çok teşekkürler.
Sayın antonio, verdiğiniz kodları dosyaya uyguladım. Makroyu çalıştırdığımda ANA sayfadaki kayıtlar kayboluyor ve diğer sayfalara kayıt gelmiyor.

Benim yazdığım kodlar, 2.sayfadan son sayfaya kadar (anasayfa hariç) verileri toplayıp anasayfaya işliyor.
İstediğiniz bu değil miydi?


Saat 10:24

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.