Sayfada ara varsa taşı yoksa uyar

[serkan_1981]

Merhaba

Excel dosyamda sayfalar arasında arama yaparak bir sayfadan bir sayfaya kopyalama yapmak istiyorum.dosyaya açıklama yazdım.
Lütfen yardımlarını bekliyorum..

 

[Korhan Ayhan]

Selamlar,

Forumumuza hoşgeldiniz.

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Hücre As Range, Olmayan_İsimler As String
 
    Set S1 = Sheets("liste")
    Set S2 = Sheets("veriler")
 
    For Each Hücre In Range("B2:B19,B21:B38,B40:B57")
        If Hücre.Value = "" Then
            Range("B" & Hücre.Row & ":D" & Hücre.Row).ClearContents
            GoTo Devam
        End If
 
        If WorksheetFunction.CountIf(S2.Range("A:A"), Hücre.Value) > 0 Then
            Hücre.Offset(0, 1) = WorksheetFunction.VLookup(Hücre.Value, S2.Range("A:C"), 2, 0)
            Hücre.Offset(0, 2) = WorksheetFunction.VLookup(Hücre.Value, S2.Range("A:C"), 3, 0)
        Else
            If Olmayan_İsimler = "" Then
                Olmayan_İsimler = Hücre.Value
            Else
                Olmayan_İsimler = Olmayan_İsimler & Chr(10) & Hücre.Value
            End If
        End If
Devam:
    Next
 
    If Olmayan_İsimler = "" Then
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    Else
        MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & "Aşağıdaki isimler bulunamadı !" & _
        Chr(10) & Chr(10) & Olmayan_İsimler, vbInformation
    End If
 
    Set S1 = Nothing: Set S2 = Nothing
End Sub

 

[serkan_1981]

Merhaba

ilginize teşekkür ederim.İhtiyacıma uygun bir makro olmuş.