Satır Kopyalama

Katılım
6 Temmuz 2017
Mesajlar
13
Excel Vers. ve Dili
excel 2010
Altın Üyelik Bitiş Tarihi
01-10-2023
Merhaba Hocalarım,

Yaklaşık 50.000 Satırlı bir datam var. Data A2:BG50000 kadar gitmekte ve sayı değişkenli gösterebilmektedir (max 100.000 oluyor)

Yapmak istediğim şu;
-Sayfa 2'de A1 Hücresindeki değeri; Data sayfası BG2:BG50000'de arayacak, eşleşen değerlerin solundaki bütün satırları kopyalayacak ve Sayfa 2'de A2'den başlayacak şekilde Yapıştıracak.
-Sayfa 3'e geçtiğimde ve kodu bu sayfada çalıştırdığımda, aynı işlemi tekrarlayacak.

Yarımlarınız için çook teşekkür ederim,
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,274
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit

Sub Bul_Aktar()
    Dim S1 As Worksheet, Aranan As Variant
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sayfa1")
    
    If ActiveSheet.Name <> S1.Name Then
        Aranan = Range("A1")
        Range("A2:BG" & Rows.Count).Clear
        S1.Range("A1:BG" & S1.Rows.Count).AutoFilter 59, Aranan
        If S1.Cells(S1.Rows.Count, 1).End(3).Row > 1 Then
            S1.Range("A1").CurrentRegion.Copy Range("A2")
            S1.Range("A1").CurrentRegion.Interior.Color = vbGreen
        End If
        S1.ShowAllData
    End If
    
    S1.Range("A1:BG1").Interior.Color = xlNone
    
    Set S1 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Aktarım tamamlanmıştır.", vbInformation
End Sub
 
Katılım
6 Temmuz 2017
Mesajlar
13
Excel Vers. ve Dili
excel 2010
Altın Üyelik Bitiş Tarihi
01-10-2023
Hocam çok teşekkür ederim. Elinize sağlık, çok güzel oldu. :)))
 
Katılım
6 Temmuz 2017
Mesajlar
13
Excel Vers. ve Dili
excel 2010
Altın Üyelik Bitiş Tarihi
01-10-2023
Deneyiniz.

C++:
Option Explicit

Sub Bul_Aktar()
    Dim S1 As Worksheet, Aranan As Variant
   
    Application.ScreenUpdating = False
   
    Set S1 = Sheets("Sayfa1")
   
    If ActiveSheet.Name <> S1.Name Then
        Aranan = Range("A1")
        Range("A2:BG" & Rows.Count).Clear
        S1.Range("A1:BG" & S1.Rows.Count).AutoFilter 59, Aranan
        If S1.Cells(S1.Rows.Count, 1).End(3).Row > 1 Then
            S1.Range("A1").CurrentRegion.Copy Range("A2")
        End If
        S1.ShowAllData
    End If
   
    Set S1 = Nothing
   
    Application.ScreenUpdating = True
   
    MsgBox "Aktarım tamamlanmıştır.", vbInformation
End Sub
Hocam rica etsem kopyalanan satırları, örnek veriyorum yeşil rengiyle renklendirebilirmisiniz?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,274
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Hangi sayfada renklenecek?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,274
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Üstte ki mesajımdaki kodu revize ettim. Son halini deneyiniz.
 
Üst