• DİKKAT

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

sayfaya uyarlama

mersilen

Destek Ekibi
Destek Ekibi
Katılım
31 Aralık 2009
Mesajlar
1,105
Excel Vers. ve Dili
excel 2007 türkçe
Excel Vers. ve Dili Ofis 2003
herkese kolay gelsin
sayfa 2 de çalışan bu kodun
sayfa 3 de a1:af31 arasında da aynısını yapmasını istiyorum kodun içindeki if döngüsünü ayarlıyabiliyorum ama sayfa 3 ü nasıl gösterebilirim
hatalı olduğunu sandığım kısmı kırmızıyla gösterdim



Private Sub Worksheet_Change(ByVal Target As range)
If Intersect(Target, [A103]) Is Nothing Then Exit Sub
Dim i,k As Integer
Application.ScreenUpdating = False
range("A105:AF135").Interior.ColorIndex = xlNone
For i = 105 To 135
range("a" & i & ":af" & i).Interior.ColorIndex = 0
Next i
For i = 105 To 135
If Application.Weekday(Cells(i, "a"), 2) > 5 Then
range("C" & i & ":V" & i, "Y" & i & ":AF" & i).ClearContents
range("A" & i & ":V" & i, "Y" & i & ":AF" & i).Interior.ColorIndex = 3
End If
Next i

worksheet(3).activate

range("A1:AF31").Interior.ColorIndex = xlNone
For k = 1 To 31
range("a" & i & ":af" & i).Interior.ColorIndex = 0
Next k
For k = 1 To 31
If Application.Weekday(Cells(i, "a"), 2) > 5 Then
range("C" & i & ":V" & i, "Y" & i & ":AF" & i).ClearContents
range("A" & i & ":V" & i, "Y" & i & ":AF" & i).Interior.ColorIndex = 3
End If
Next k
sheet(2).range("a104").select

Application.ScreenUpdating = False
End Sub
 

Ekli dosyalar

Son düzenleme:
Slm arkadaşım,

Ne yapmak istediğini anlayamadım ama;

Sheets("Sheet3").Select
sheets("Sheet2").Range("A104").Select

denermisin?
 
arkadaşım sağol ama olmadı
tablo ekledim tekrar bakabilir misin?
 
selam
yardım edebilecek yok mu?
 
Selamlar,

Aşağıdaki kodu kullanabilirsiniz.

Kod:
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Integer

    If Intersect(Target, [A103]) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    Range("A105:AF135").Interior.ColorIndex = xlNone
    
    For X = 105 To 135
        If Weekday(Cells(X, 1), 2) > 5 Then
            Range("C" & X & ":AF" & X).ClearContents
            Range("A" & X & ":AF" & X).Interior.ColorIndex = 3
        End If
    Next
    
    With Sheets("Sayfa3")
            
    .Range("A1:AF31").Interior.ColorIndex = xlNone
        
    For X = 1 To 31
        If Weekday(.Cells(X, 1), 2) > 5 Then
            .Range("C" & X & ":AF" & X).ClearContents
            .Range("A" & X & ":AF" & X).Interior.ColorIndex = 3
        End If
    Next
    
    End With
    
    Application.ScreenUpdating = True
End Sub
 
korhan hocam
sayenizde sorun çözüldü
geri dönüş cevabım elde olmayan sebeblerden dolayı biraz geç oldu
kusura bakmayın
 
Geri
Üst