• DİKKAT

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

hücre temizleme

Kod: 
Sub sil()
[B]Application.ScreenUpdating = False[/B]
Dim hucre As Range
Dim sh As Worksheet
Dim sifre As String
sifre = InputBox("şifrenizi yazınız", "şifre")
For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("A").Name And _
       sh.Name <> Sheets("B").Name And sh.Name <> Sheets("C").Name Then
        sh.Unprotect sifre
        sh.Select
        For Each hucre In Range("A1:Y137")
            If hucre.Interior.ColorIndex = 2 Then hucre.ClearContents
        Next
    sh.Protect sifre
    End If
Next
MsgBox "Silme &#304;&#351;lemi Tamamland&#305;..!!"
[B]Sheets("RAPOR").Select
Application.ScreenUpdating = False[/B]
End Sub

Koyu renkli sat&#305;rlar&#305; yeni ilave ettim, &#231;al&#305;&#351;ma kitab&#305;ndada d&#252;zenleyiniz.

&#350;ifre A&#231; makrosunu &#231;al&#305;&#351;t&#305;rn ve dosyalar&#305;n&#305;z &#351;ifresiz iken inputboxa istedi&#287;ini &#351;ifreyi yaz&#305;n t&#252;m sayfalar sizin belirledi&#287;iniz &#351;ifre ile &#231;al&#305;&#351;acakt&#305;r.

Kod: 
Sub SifreAc()
For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("A").Name And _
       sh.Name <> Sheets("B").Name And sh.Name <> Sheets("C").Name Then sh.Unprotect "1234"
Next
End Sub


Sub Sifrele()
For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("A").Name And _
       sh.Name <> Sheets("B").Name And sh.Name <> Sheets("C").Name Then sh.Unprotect "1234"
Next
End Sub

Dosya ve a&#231;&#305;klmay&#305; &#351;imd ekleyecem
 
Son düzenleme:
hsayar' Alıntı:
Kod: 
Sub sil()
[B]Application.ScreenUpdating = False[/B]
Dim hucre As Range
Dim sh As Worksheet
Dim sifre As String
sifre = InputBox("&#351;ifrenizi yaz&#305;n&#305;z", "&#351;ifre")
For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("A").Name And _
       sh.Name <> Sheets("B").Name And sh.Name <> Sheets("C").Name Then
        sh.Unprotect sifre
        sh.Select
        For Each hucre In Range("A1:Y137")
            If hucre.Interior.ColorIndex = 2 Then hucre.ClearContents
        Next
    sh.Protect sifre
    End If
Next
MsgBox "Silme &#304;&#351;lemi Tamamland&#305;..!!"
[B]Sheets("RAPOR").Select
Application.ScreenUpdating = False[/B]
End Sub

Koyu renkli sat&#305;rlar&#305; yeni ilave ettim, &#231;al&#305;&#351;ma kitab&#305;ndada d&#252;zenleyiniz.

&#350;ifre A&#231; makrosunu &#231;al&#305;&#351;t&#305;rn ve dosyalar&#305;n&#305;z &#351;ifresiz iken inputboxa istedi&#287;ini &#351;ifreyi yaz&#305;n t&#252;m sayfalar sizin belirledi&#287;iniz &#351;ifre ile &#231;al&#305;&#351;acakt&#305;r.

Kod: 
Sub SifreAc()
For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("A").Name And _
       sh.Name <> Sheets("B").Name And sh.Name <> Sheets("C").Name Then sh.Unprotect "1234"
Next
End Sub


Sub Sifrele()
For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("A").Name And _
       sh.Name <> Sheets("B").Name And sh.Name <> Sheets("C").Name Then sh.Unprotect "1234"
Next
End Sub

Dosya ve a&#231;&#305;klmay&#305; &#351;imd ekleyecem
Genişletmek için tıkla ...

ba&#351;ka ne isteyim ben sizden karde&#351;im ellerin dert g&#246;rmesin allah raz&#305; olsun bu kodlar&#305; butonun oldu vb modulune ekliyorum &#231;al&#305;&#351;t&#305;r&#305;m de&#287;ilmi. ger&#231;ekten &#231;ok u&#287;ra&#351;tr&#305;d&#305; ama i&#351;ime yar&#305;yacak art&#305;k beni b&#252;y&#252;k kabustan kurtard&#305;n ne kadar te&#351;ekk&#252;r etsem az

peki sildikten sonra k&#252;rsor&#252; istenilen h&#252;creye y&#246;nlendirebilirmiyiz yani g&#252;n sayfalar&#305;nda h&#252;cre a6 t1-t2-73 lerde ise a4 h&#252;cresi secili olacak
 
Son düzenleme:
Sheets("RAPOR").Select

satr&#305;n&#305;
Sheets("t....").Range("a4").Select
veya
Sheets("Pazaetesi").Range("a6").Select
sadece bir sat&#305;ra ya&#246;nlendirebilirsin
 
hsayar' Alıntı:
Sheets("RAPOR").Select

satr&#305;n&#305;
Sheets("t....").Range("a4").Select
veya
Sheets("Pazaetesi").Range("a6").Select
sadece bir sat&#305;ra ya&#246;nlendirebilirsin
Genişletmek için tıkla ...



Sub sil()
Dim hucre As Range
Dim sh As Worksheet
Dim sifre As String
sifre = InputBox("&#350;ifreyi Giriniz", "&#350;&#304;FRE?")
If sifre = "1234" Then
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("TE").Name And _
sh.Name <> Sheets("TEL").Name And sh.Name <> Sheets("AK").Name And _
sh.Name <> Sheets("B&#304;R").Name And sh.Name <> Sheets("H").Name And _
sh.Name <> Sheets("PO").Name Then
sh.Unprotect sifre
sh.Select
For Each hucre In Range("A1:AB150")
If hucre.Interior.ColorIndex = 2 Then hucre.ClearContents
Next
sh.Protect sifre
End If
Next
MsgBox "Silme &#304;&#351;lemi Tamamland&#305;!.."
Else
MsgBox " HATALI &#350;&#304;FRE "
End If
End Sub
Sub SifreAc()
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> Sheets("RA").Name And sh.Name <> Sheets("TE").Name And _
sh.Name <> Sheets("TEL").Name And sh.Name <> Sheets("AK").Name And _
sh.Name <> Sheets("B&#304;").Name And sh.Name <> Sheets("HD").Name And _
sh.Name <> Sheets("POS").Name Then sh.Unprotect "1234"
Else
Next
End Sub
Sub Sifrele()
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("TE").Name And _
sh.Name <> Sheets("TE").Name And sh.Name <> Sheets("AK").Name And _
sh.Name <> Sheets("B&#304;R").Name And sh.Name <> Sheets("HD").Name And _
sh.Name <> Sheets("PO").Name Then sh.Unprotect "1234"
Next
End Sub

burada nereye ekliyecez anlayamad&#305;m pardon
ptesi sayfas&#305;nda a6
sal&#305; -cars per.. vs. a6
t1-t2-t3 vs. a4 h&#252;creleri secili olcak
 
&#351;ifrenin 3 haneden fazla olmas&#305; durumunda hata veriyor 123 dersek kabul ediyor fakat 1234 desek caps lock kapal&#305; falan diye bir uyar&#305; veriyor string de&#287;ilde ba&#351;ka bir tan&#305;mlama yapmak gerekir acaba
 
Hangi sayfaya gitmek istiyorsan k&#305;rm&#305;z&#305; sat&#305;r&#305; d&#252;zenleyiniz
Kod: 
Sub sil()
Application.ScreenUpdating = False
Dim hucre As Range
Dim sh As Worksheet
Dim sifre As String
sifre = InputBox("&#351;ifrenizi yaz&#305;n&#305;z", "&#351;ifre")
For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("A").Name And _
       sh.Name <> Sheets("B").Name And sh.Name <> Sheets("C").Name Then
        sh.Unprotect sifre
        sh.Select
        For Each hucre In Range("A1:Y137")
            If hucre.Interior.ColorIndex = 2 Then hucre.ClearContents
        Next
    sh.Protect sifre
    End If
Next
MsgBox "Silme &#304;&#351;lemi Tamamland&#305;..!!"
[color="Red"]
Sheets("Pazartesi").Range("a6").Select
Sheets("Sal&#305;").Range("a6").Select
.........&#351;eklinde devam ediniz
Sheets("t1").Range("a4").Select
Sheets("t2").Range("a4").Select
...........&#351;eklinde devam ediniz
Sheets("RAPOR").Select
 [/color]
Application.ScreenUpdating = False
End Sub

Kod: 
Sub SifreAc()
For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("A").Name And _
       sh.Name <> Sheets("B").Name And sh.Name <> Sheets("C").Name Then sh.Unprotect "1234"
Next
End Sub

ben size en son bu &#351;ekilde &#351;ifreleyip vermi&#351;tim. bu makroyu &#231;al&#305;&#351;t&#305;rd&#305;ktan sonra sil makrosunda inputboxa ne girdiyseniz &#351;ifreniz onunla g&#252;ncellenir
yeni &#351;ifre girene kadar ge&#231;erli olan budur?
 
siz bana ister &#246;zel mesaj olarak ister buraya yazarak hangi &#351;ifreyi kullanacaksan&#305;z s&#246;yleyin ben ona g&#246;re &#351;ifreleyip g&#246;ndereyim
 
Sheets("Pazartesi").Range("a6").Select
Sheets("Sal&#305;").Range("a6").Select
.........&#351;eklinde devam ediniz
Sheets("t1").Range("a4").Select
Sheets("t2").Range("a4").Select
...........&#351;eklinde devam ediniz
Sheets("RAPOR").Select
bu k&#305;s&#305;m hata veriyor istenen h&#252;creler e g&#246;ndermiyor kursor&#252;
 
Kod: 
 Sub sil()
Application.ScreenUpdating = False
Dim hucre As Range
Dim sh As Worksheet
Dim sifre As String
sifre = InputBox("&#351;ifrenizi yaz&#305;n&#305;z", "&#351;ifre")
For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("A").Name And _
       sh.Name <> Sheets("B").Name And sh.Name <> Sheets("C").Name Then
        sh.Unprotect sifre
        sh.Select
        For Each hucre In Range("A1:Y137")
            If hucre.Interior.ColorIndex = 2 Then hucre.ClearContents
        Next
    sh.Protect sifre
    End If
Next

Sheets("PTES&#304;").Select:         Range("a6").Select
Sheets("SALI").Select:          Range("a6").Select
Sheets("&#199;AR&#350;").Select:          Range("a6").Select
Sheets("PER&#350;").Select:          Range("a6").Select
Sheets("CUMA").Select:          Range("a6").Select
Sheets("CTES&#304;").Select:         Range("a6").Select
Sheets("PAZAR").Select:         Range("a6").Select
Sheets("T1").Select:            Range("a4").Select
Sheets("T2").Select:            Range("a4").Select
Sheets("T3").Select:            Range("a4").Select
Sheets("T4").Select:            Range("a4").Select
Sheets("T5").Select:            Range("a4").Select
Sheets("T6").Select:            Range("a4").Select
Sheets("T7").Select:            Range("a4").Select
Sheets("RAPOR").Select:         Range("a1").Select
Application.ScreenUpdating = False
MsgBox "Silme &#304;&#351;lemi Tamamland&#305;..!!"
End Sub

bunu deneyin


&#351;imdi ustalara benim bir sorum var
Sheets("T7").Select: Range("a4").Select

bunun k&#305;sa yaz&#305;m&#305; yokmu
Sheets("T7").Range("a4").Select
gibi hata veriyor hi&#231; dikkat etmemi&#351;tim
 
hsayar &#231;ok te&#351;ekk&#252;r ederim bu g&#252;n deneyebildim ama problemsiz &#231;al&#305;&#351;&#305;yor tek kelimeyle harika
 
rapor sayfas&#305;na konulan ba&#351;ka bir buton yard&#305;m&#305;yla pazar sayfas&#305;ndaki o4-o33 o37-o56 .... gibi h&#252;crelerindeki stoklar&#305; ptesi sayfas&#305;ndaki f4-f33 f37-f56 gibi h&#252;cre aral&#305;klar&#305;na &#252;r&#252;n giri&#351;i olarak aktar&#305;lmas&#305; i&#351;leminin yapmak istiyorum fakat o4 v.s h&#252;creleri beyaz ve korumas&#305;z f4vs h&#252;creleri korumal&#305; ve gri renk yard&#305;m&#305;nlar&#305;n&#305;z&#305; bekliyorum
 
konu anla&#351;&#305;lmad&#305; san&#305;&#305;rm cevap gelmedi hi&#231;
 
Sub AKTAR()
Set s1 = Sheets("PAZAR")
Set S2 = Sheets("PTES&#304;")
Sheets("PAZAR").Select
s1.[O4:O33].Copy
Sheets("PTES&#304;").Unprotect 'P
S2.[F4:F33].PasteSpecial Paste:=xlPasteValues
s1.[O37:O56].Copy 'J
S2.[F37:F56].PasteSpecial Paste:=xlPasteValues
s1.[O60:O73].Copy 'B
S2.[F60:F73].PasteSpecial Paste:=xlPasteValues
s1.[O77:O92].Copy 'IMP
S2.[F77:F92].PasteSpecial Paste:=xlPasteValues
s1.[O96:O115].Copy 'R
S2.[F96:F115].PasteSpecial Paste:=xlPasteValues
s1.[O124].Copy 'SO
S2.[F124].PasteSpecial Paste:=xlPasteValues
s1.[O126:O131].Copy 'EF
S2.[F126:F131].PasteSpecial Paste:=xlPasteValues
s1.[O133:O135].Copy 'S
S2.[F133:F135].PasteSpecial Paste:=xlPasteValues

s1.[Z4:Z40].Copy 'TE
S2.[S4:S40].PasteSpecial Paste:=xlPasteValues
s1.[Z42:Z92].Copy 'ME
S2.[S42:S92].PasteSpecial Paste:=xlPasteValues

s1.[B89].Copy 'KASA
S2.[C4].PasteSpecial Paste:=xlPasteValues

Sheets("PTES&#304;").Select ActiveSheet.Protect
Sheets("RAPOR").Select: Range("J19").Select
End Sub
Sub sil()
Application.ScreenUpdating = False
Dim hucre As Range
Dim sh As Worksheet
Dim sifre As String
sifre = InputBox("&#350;ifreyi Giriniz", "&#350;&#304;FRE?")
If sifre = "1234" Then
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("TEK").Name And _
sh.Name <> Sheets("TE").Name And sh.Name <> Sheets("AK").Name And _
sh.Name <> Sheets("B&#304;").Name And sh.Name <> Sheets("HD").Name And _
sh.Name <> Sheets("PO").Name Then
sh.Unprotect sifre
sh.Select
For Each hucre In Range("A1:AB150")
If hucre.Interior.ColorIndex = 2 Then hucre.ClearContents
Next
sh.Protect sifre
End If
Next
Sheets("PTES&#304;").Select: Range("a6").Select
Sheets("SALI").Select: Range("a6").Select
Sheets("&#199;AR&#350;").Select: Range("a6").Select
Sheets("PER&#350;").Select: Range("a6").Select
Sheets("CUMA").Select: Range("a6").Select
Sheets("CTES&#304;").Select: Range("a6").Select
Sheets("PAZAR").Select: Range("a6").Select
Sheets("T1").Select: Range("B4").Select
Sheets("T2").Select: Range("B4").Select
Sheets("T3").Select: Range("B4").Select
Sheets("T4").Select: Range("B4").Select
Sheets("T5").Select: Range("B4").Select
Sheets("T6").Select: Range("B4").Select
Sheets("T7").Select: Range("B4").Select
Sheets("RAPOR").Select: Range("J19").Select
Application.ScreenUpdating = False
MsgBox "Silme &#304;&#351;lemi Tamamland&#305;!.."
Else
MsgBox " HATALI &#350;&#304;FRE "
End If
End Sub
Sub SifreAc()
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("TEK").Name And _
sh.Name <> Sheets("TE").Name And sh.Name <> Sheets("AK").Name And _
sh.Name <> Sheets("B&#304;").Name And sh.Name <> Sheets("HD").Name And _
sh.Name <> Sheets("PO").Name Then sh.Unprotect "1234"
Else
Next
End Sub
Sub Sifrele()
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> Sheets("RAPOR").Name And sh.Name <> Sheets("TEK").Name And _
sh.Name <> Sheets("TE").Name And sh.Name <> Sheets("AK").Name And _
sh.Name <> Sheets("B&#304;").Name And sh.Name <> Sheets("HD").Name And _
sh.Name <> Sheets("PO").Name Then sh.Unprotect "1234"
Next
End Sub
 
Sayın Excel üstadları lütfen yardım edin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst