AccessTr.neT

Merhaba arkadaşlar.
Aşağıdaki kodu ekte bulunan çalışma kitabının bütün sayfalarına aynı anda kayıt yapabilmesi için revize edebilirmiyiz.







Private Sub cmdYENİKAYIT_Click()
Sheets("Ocak").Select
On Error Resume Next

Dim j As Long, Sh As Worksheet, bak As Range, say As Integer

Set Sh = Sheets("Ocak")
j = Sh.Cells(65536, 3).End(xlUp).Row + 1

For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
If bak.Value = TextBox2.Value Then
MsgBox "Bu Kayıt numarası bulundu."
Exit Sub
End If

If TextBox2.Text = "" Then
MsgBox "Lütfen önce Malzemenin / İlacın Adını Giriniz...", , "Kayıt Hatası!!!"
Exit Sub
End If

If TextBox5.Text = "" Then
MsgBox "Lütfen Depo Mevcudu Bilgisini Giriniz...", , "Kayıt Hatası!!!"
Exit Sub
End If

If TextBox6.Text = "" Then
MsgBox "Lütfen Kritik Seviye Bilgisini Giriniz...", , "Kayıt Hatası!!!"
Exit Sub
End If

Next bak
For Each bak In Range("C1:C" & WorksheetFunction.CountA(Range("C1:C65000")))
If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox2.Value, vbUpperCase) Then
MsgBox "" & TextBox2.Value & "Bu isminde bir kaydınız zaten mevcut, aynı malzemeden mükerrer kayıt yapamazsınız!"
Exit Sub
End If

Next bak
n = Cells(65536, 3).End(xlUp).Row - 4
Label9 = n

Sh.Cells(j, "B").Value = Label9 * 1
Sh.Cells(j, "B").HorizontalAlignment = xlCenter
Sh.Cells(j, "C").Value = TextBox2.Value
Sh.Cells(j, "D").Value = TextBox8.Value
Sh.Cells(j, "E").Value = TextBox5.Value
Sh.Cells(j, "AQ").Value = TextBox6.Value

Sh.Cells(j, "A").Rows.Formula = "=IF(RC[3]="""",0,RC[3]-R2C3)"
Sh.Cells(j, "AP").Rows.Formula = "=SUM(RC[-5]:RC[-2])"
Sh.Cells(j, "AR").Rows.Formula = "=IF(AND(RC[-39]<=0),""Yok"",IF(AND(RC[-39]<RC[-1]),""Kritik"",IF(AND(RC[-39]>=RC[-1]),""Mevcut"")))"

MsgBox "" & TextBox2.Value & " Malzemesine Ait Yeni Kayıt Başarıyla Yapılmıştır. İyi Çalışmalar Dilerim", vbInformation, "Sn. " & Application.UserName

Range("B6:B65500").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'************************
Range("c6:ar65500").Select
Selection.Sort Key1:=Range("c6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Label9 = WorksheetFunction.Count(Range("b1:b65500")) + 1

cmdTEMİZLE_Click
ComboBox2_Change
TextBox2.SetFocus
Unload UserForm1
UserForm1.Show
End Sub

Sn.duayen Paylaşım İçin Teşekkür Ederiz,Ancak Paylaştığınız Çalışmaya Dair Kısa Bir Bilgi Yazmış Olsanız Çok Daha İyi Olurdu Diye Düşünüyorum.

Haklısınız düzeltildi özür dilerim