• DİKKAT

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

Sayfaları otomatik gizleyip aktarma

NADİR YILDIZ

Altın Üye
Katılım
7 Ocak 2006
Mesajlar
1,418
Excel Vers. ve Dili
2016 Türkçe
Arkadaşlar benim yapmak istediğim kontrol sütununda evet yazdığımda yazdığım satırı ( A-E ) kadar sarı kırmızı boyamalı EVET sayfasına aktarmalı,hayır yazdığımda ise yazdığım satırı ( A-E ) kadar mavi kırmızıya boyamasını ve hayır sayfasına aktarmasını istiyorum..Ayrıca evet hayır yazdığım satıları gizlemesinide ve istiyorum..
 

Ekli dosyalar

Sayfa1 in kod editörüne aşağıdaki kodları kopyalayın

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SonSatir As Integer
    Dim Sayfa As String
    If Target.Column = 4 And Target.Value = "EVET" Or Target.Value = "HAYIR" Then
        
        SonSatir = Sheets(Target.Value).Range("A6550").End(3).Row + 1
        
        Sheets(Target.Value).Range("A" & SonSatir).Value = Range("A" & Target.Row).Value
        Sheets(Target.Value).Range("B" & SonSatir).Value = Range("B" & Target.Row).Value
        Sheets(Target.Value).Range("C" & SonSatir).Value = Range("C" & Target.Row).Value
        Sheets(Target.Value).Range("D" & SonSatir).Value = Range("D" & Target.Row).Value
        Sheets(Target.Value).Range("E" & SonSatir).Value = Range("E" & Target.Row).Value
        
        
        Sheets(Target.Value).Range("A" & SonSatir & ":E" & SonSatir).Font.Color = -16776961
        Range("A" & Target.Row & ":E" & Target.Row).Font.Color = -16776961
        If Target.Value = "EVET" Then
            Sheets(Target.Value).Range("A" & SonSatir & ":E" & SonSatir).Interior.Color = 65535
            Range("A" & Target.Row & ":E" & Target.Row).Interior.Color = 65535
        ElseIf Target.Value = "HAYIR" Then
            Sheets(Target.Value).Range("A" & SonSatir & ":E" & SonSatir).Interior.Color = 15849925
            Range("A" & Target.Row & ":E" & Target.Row).Interior.Color = 15849925
        End If
        
        Rows(Target.Row).EntireRow.Hidden = True
    End If
End Sub
 
sayın dalgalikur teşekkür ederim.. istediğim gibi olmuş
 
Geri
Üst