Sayfalar arası Kopyalama...

[yasaramca]

Merhaba,

Ekteki excel dosyasında yapmak istediğim. Sayfa1'deki butonu tıklayınca ilk sheet'den başlayacak D kolonlarındaki değerlerin 20'den küçük olalarının bir kopyasını Sayfa 1' e kopyalacak.Tüm sheetleri sıra ile gezecek. Tekrar butonu tıkladığımızda Sayfa1'i temizleyecek. Aynı işllemi tekrardan yapacak.

Yardımlarınız için şimdiden teşekkürler,

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Option Explicit

Sub AKTAR()
    Dim Sayfa As Worksheet, X As Long, Satir As Long
    
    Sheets("Sayfa1").Range("A:H").Clear
    Satir = 1
    
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "Sayfa1" Then
            For X = 2 To Sayfa.Cells(Rows.Count, "D").End(3).Row
                If Sayfa.Cells(X, "D") < 20 Then
                    Sayfa.Range("A" & X & ":H" & X).Copy Sheets("Sayfa1").Cells(Satir, 1)
                    Satir = Satir + 1
                End If
            Next
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub