• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru Makro Birleştirme

S

Sefa1994

Katılım
12 Mart 2020
Mesajlar
71
Excel Vers. ve Dili
365
Merhabalar, Dün Bi arkadaşımız güncelle butonu ile benzersiz veri aktarımı hakkında yardımcı olmuştu ve aşağıda ki kodu yazmıştı tekrar ondan yardım isteyip rahatsız etmek istemedim o yüzden size sorayım dedim. Bu kodda sayfa 1 deki b sütununda olan benzersiz verileri sayfa 2 de ki a40 ve altına benzersiz olanları ekliyordu tekrar edilenleri eklemiyordu. Ben bununla beraber safa 1 deki b sütunun yanında I sütununda olan yazıları da sayfa 2 de ki b 40 ve altına yazdırmak istiyorum. şöyle ki; sayfa 1 b sütunu ve onun yanında yazan I sütununda ki veriyi sayfa 2 de a 40 ve yanında b 40 a ekle yardımcı olabilirseniz çok sevinirim. isteyene excel şablonunu da gönderirim. şimdiden teşekkürler..
Kod: 
Sub aktar()
Dim son
Dim son2
Dim i
son = Sheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row
son2 = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
If son2 >= 39 Then GoTo atla:

Sheets("Sayfa2").Range("a40:a" & son2).ClearContents
atla:
For i = 2 To son
son2 = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
If WorksheetFunction.CountIf(Sheets("Sayfa2").Range("a1:a" & son2), Sheets("Sayfa1").Cells(i, 2)) = 0 Then
Sheets("Sayfa2").Cells(son2 + 1, 1).Value = Sheets("Sayfa1").Cells(i, 2).Value
End If

Next
End Sub
 
Deneyiniz, örnek dosya olmadığından ben deneyemedim:

PHP: 
Sub aktar()
Dim son
Dim son2
Dim i
son = Sheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row
son2 = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
If son2 >= 39 Then GoTo atla:
Sheets("Sayfa2").Range("a40:a" & son2).ClearContents

    atla:
For i = 2 To son
    son2 = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
    If WorksheetFunction.CountIf(Sheets("Sayfa2").Range("a1:a" & son2), Sheets("Sayfa1").Cells(i, 2)) = 0 Then
        Sheets("Sayfa2").Cells(son2 + 1, "A").Value = Sheets("Sayfa1").Cells(i, "B").Value
        Sheets("Sayfa2").Cells(son2 + 1, "B").Value = Sheets("Sayfa1").Cells(i, "I").Value
    End If
Next
End Sub
 
linki buraya bıraktım hocam düğmeye tıklayınca sayfa 1 deki a ve b sütunlarından sayfa 2 deki a 40 ve b 40 a gitmesi gerekiyor. ama tekrarsız olarak 2 kere tekrarlanan veriler 1 kere gidecek sadece. Kodu da buraya yazdım tekrar.
Kod: 
Sub aktar()
Dim son
Dim son2
Dim i
son = Sheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row
son2 = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
If son2 >= 39 Then GoTo atla:

Sheets("Sayfa2").Range("a40:a" & son2).ClearContents
atla:
For i = 2 To son
son2 = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
If WorksheetFunction.CountIf(Sheets("Sayfa2").Range("a1:a" & son2), Sheets("Sayfa1").Cells(i, 2)) = 0 Then
Sheets("Sayfa2").Cells(son2 + 1, 1).Value = Sheets("Sayfa1").Cells(i, 2).Value
End If

Next
End Sub
 
Sizin yazdığınız kodda a40 a gidiyor fakat b40 a gitmiyor yazılanlar
 
Kod kodda yazılan işlemi tam olarak yapıyor. Ya ne yapmak istediğinizi tam anlatamadınız ya da dosyanızı uygun hazırlamadınız. Kodun ne yaptığını anlatayım:

Önce Sayfa2'nin A sütunundaki son dolu satır numarasını buluyor. Eğer bu sayı 38'den büyükse Sayfa2'nin A sütununda 39. satırın altındaki verileri siliyor.

Sonra sırasıyla Sayfa1'in B sütunundaki veriyi Sayfa2'nin A sütununda arıyor. Eğer sayfa1'in B sütunundak iveri Sayfa2'nin A sütununda yoksa Sayfa1'in B sütunundaki veriyle I sütunundaki veriyi Sayfa2'nin altına ekliyor.

Örnek olarak dosyanızda Sayfa1'în B8 hücresine Ali ve I8 hücresine 1 yazıp düğmeye bastığımda bu veriler Sayfa2'ye eklendi.
 
çok teşekkürler hocam ben bi şeyi eksik yapıyormuşum kopyalayıp düzenlerken. tekrar saolun
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst