Bütün sayfalara aynı anda kayıt yapmak istiyorum.
Tarih
01/03/2011 14:18
Konu Sahibi
DUAYEN
Yorumlar
2
Okunma
1804
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 5
  • 4
  • 3
  • 2
  • 1

Derecelendirme: 0/5 - 0 oy



DUAYEN
Aktif Üye
Kullanici Avatari
Aktif Üye
S.... A....
1.026
13/08/2010
279
Yozgat
Ofis 2007
28/10/2016,11:41
Sponsor Reklam
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

Cevapla

life_exciting
Aktif Üye
Kullanici Avatari
Aktif Üye
837
28/12/2009
361
Ankara
Ofis 2003
18/11/2010,00:42
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.

Cevapla

DUAYEN
Aktif Üye
Kullanici Avatari
Aktif Üye
S.... A....
1.026
13/08/2010
279
Yozgat
Ofis 2007
28/10/2016,11:41
Sponsor Reklam
Haklısınız düzeltildi özür dilerim
Cevapla


Konuyu Okuyanlar: 1 Ziyaretçi


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Tarih Son Yorum
  Cari Kayıt ogulcan92 10 5.272 17/02/2013, 22:34 ORHAN ALKAN
Exclamation Form mail Excel Kayıt Problemi umtysr 7 3.314 22/02/2011, 00:54 Yandemir


Türkçe Çeviri: MCTR, Yazılım: MyBB, © 2002-2017 MyBB Group.
DMCA.com Protection Status
© Desing by XSTYLED| Develops by ozanakkaya