• DİKKAT

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

iki ayrı makronun birleştirilmesi

ismailozkan4224

Altın Üye
Katılım
22 Kasım 2011
Mesajlar
175
Excel Vers. ve Dili
2007 türkçe
değerli arkadaşlar aşağıdaki makro ile dosyamda ilgili işleri yapabiliyorum.

Option Explicit

bu kısım hata veriyor. bu olunca hata veriyor. bu olmadan da verileri güncellemiyor.

hata mesajı
Variable no defined
'----------------------------------------------------------------------
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo son
If Intersect(Target, [C3:C50]) Is Nothing Then Exit Sub
Cells(Target.Row, "H:H") = Cells(1, 1)
Cells(Target.Row, "E:E") = Cells(1, 6) & " " & Cells(1, 9)

Cells(Target.Row, "D:.D") = Cells(Target.Row, "B") & " " & Cells(Target.Row, "C")

Cells(Target.Row, "O:O") = Cells(1, 15)
Cells(Target.Row, "S:S") = Cells(1, 19)
Cells(Target.Row, "T:T") = Cells(1, 20)
Cells(Target.Row, "V:V") = Cells(1, 22)
Cells(Target.Row, "W:W") = Cells(1, 23)
Cells(Target.Row, "X:X") = Cells(1, 24)
Cells(Target.Row, "Y:Y") = Cells(1, 25)
Cells(Target.Row, "Z:Z") = Cells(1, 26)
Cells(Target.Row, "AA:AA") = Cells(1, 27)
Cells(Target.Row, "AB:AB") = Cells(1, 33)
Cells(Target.Row, "AC:AC") = Cells(1, 29) & " " & Cells(1, 30)
If Not Intersect(Target, [C2:C2000]) Is Nothing Then Cells(Target.Row, "AD") = Format(Now, "dd.mm.yyyy hh:mm")
son:
' OTOMATİK OLARAK B SÜTUNUNA VERİ GİRİLDİĞİNDE SIRA NUMARASI VERİR
If Target.Column <> 3 Then Exit Sub
If Target.Row = 2 Then Exit Sub
If Left(Target.Offset(0, -1), 1) = "~" Then Exit Sub
If Left(Target.Offset(0, -1), 1) = "~" Then Exit Sub
If Left(Target.Offset(0, -1), 1) = "=Row()-3" Then Exit Sub
Target.Offset(0, -2).Formula = "=Row()-3+1"

Application.EnableEvents = True
Target.Select

End Sub

ancak şu makroyu da kullanmak istiyorum. ikisini birleştirmek istiyorum. ben birleştirince hata veriyor.nasıl olmalı? ayrıca eğer mümkünse satır sil menüsü pasif oluyor onun şifre ile açılması(pasifliğinin gitmesi) mümkün mü? ya da kullanıcı adı "ACER-MÜDÜR" olanlar şifresiz silebilsin. onun haricindekiler kesinlikle silemesin. şifre istesin. benim amacım dosyayı verdiğim arkadaşlar satır ve sütunları silemesinler. ama ben lazım olunca silebileyim. ama şifre ile... teşekkür ederim

Private Sub Worksheet_Activate()
Range("A1").Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'SAYFADA SİLMEYİ ENGELLEME
If Not Intersect(Target, Range("A1:II100")) Is Nothing Then
Else
user = Environ("username")
sifre = "4207"
If user = "ACER-MÜDÜR" Then
ActiveSheet.Unprotect Password:=sifre
Cells.Locked = False
Exit Sub
ElseIf user <> "ACER-MÜDÜR" Then
a = InputBox("BU BÖLÜME GİRİŞ YAPMANIZ İÇİN ŞİFREYİ YAZINIZ.", "")
If a <> sifre Then
MsgBox "şifre yanlış"
Range("A1").Select: Exit Sub
Else
End If
If a = "" Then
MsgBox "şifre yok"
Range("A1").Select: Exit Sub
End If
If a = sifre Then
ActiveSheet.Unprotect Password:=sifre
Cells.Locked = True
Range("A1:II100").Locked = False
ActiveSheet.EnableSelection = xlNoRestrictions
ActiveSheet.Protect Password:=sifre, DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True
End If
End If
End If
End Sub
 
Son düzenleme:
Geri
Üst