Ürüne göre parti numarası vermek için

[clodj]

Sayın usubaykan, Sayın Korhan Ayhan ve Sayın kuvari
Yardımlarınız için çok teşekkür ederim.
İyi çalışmalar

 

[clodj]

Merhaba,
İlerledikçe takıldığım için sormam gerekiyor.
Ekteki örnekte G10 HÜCRESİNDE eğer "Elle" yi seçersem Değer3 için I3 ü
G10 HÜCRESİNDE eğer "Otomatik" i seçersem Değer3 için I2 yi seçmesini istiyorum.
Teşekkürler

 

[Korhan Ayhan]

Selamlar,

Basit bir eğer-if sorgusu ile sizde halledebilirdiniz. Aşağıdaki şekilde deneyiniz.

G10 hücresinin boş olma koşulunda nasıl işlem yapılacağını belirtmediğiniz için bende koda eklemedim.

Option Explicit
 
Sub Yeni_Kayıt_Ekle()
    Dim Son_Satır As Long, S1 As Worksheet, S2 As Worksheet
 
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    Son_Satır = S2.[A65536].End(3).Row + 1
 
    If S1.Range("A2") = "" Then
        MsgBox "Lütfen A2 hücresine ürün adı giriniz !", vbCritical, "Dikkat !"
        Exit Sub
    End If
 
    S2.Cells(Son_Satır, 2) = S1.Range("B2").Value
    S2.Cells(Son_Satır, 1) = S1.Range("A2").Value
    S2.Cells(Son_Satır, 3) = Date
    S2.Cells(Son_Satır, 4) = S1.Range("G2").Value
    S2.Cells(Son_Satır, 5) = S1.Range("G5").Value
[COLOR=red]    If S1.Range("G10") = "Otomatik" Then[/COLOR]
[COLOR=red]    S2.Cells(Son_Satır, 6) = S1.Range("I2").Value[/COLOR]
[COLOR=red]    ElseIf S1.Range("G10") = "Elle" Then[/COLOR]
[COLOR=red]    S2.Cells(Son_Satır, 6) = S1.Range("I3").Value[/COLOR]
[COLOR=red]    End If[/COLOR]
    S2.Cells(Son_Satır, 7) = S1.Range("J9").Value
    S2.Cells(Son_Satır, 8) = S1.Range("K2").Value
    S2.Cells(Son_Satır, 9) = S1.Range("L2").Value
    S2.Cells(Son_Satır, 10) = S1.Range("M6").Value
    S2.Cells(Son_Satır, 11) = S1.Range("N2").Value
    S2.Cells(Son_Satır, 12) = S1.Range("O2").Value
    S2.Cells(Son_Satır, 13) = S1.Range("P2").Value
    S2.Cells(Son_Satır, 14) = S1.Range("Q2").Value
    S2.Cells(Son_Satır, 15) = S1.Range("R2").Value
    S2.Cells.EntireColumn.AutoFit
    S1.Range("A2").ClearContents
    S1.Range("L2").ClearContents
    S1.Range("O2:R2").ClearContents
 
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "Yeni Kayıt Eklendi", vbInformation
End Sub

 

[clodj]

Aynı excel dosyasında kullandığım bir macroda da yukarıda eklediğiniz If formülünü eklemeye çalıştım fakat VBA bilgim 0 olduğu için yapamadım. yapmak istediğim;

F25 hücresinde "Elle" yazarsa diğer bölgeler ile aşağıdaki "H18:H23" yerine "I20:I23" e kadar olan bölgeyi kopyalasın

F25 hücresinde "Otomatik" yazarsa diğer bölgelerle "H18:H23" e kadar olan bölgeyi kopyalasın
AŞAĞIDAKİ KOD bir şarta bağlı olmadan seçili tüm alanlara otomatik olarak işlem yapıyor.



Range("A18:A23,C18:C23,H18:H23").Select
Range("H18").Activate
Selection.Copy
Sheets("Boya Değişim").Select
Range("F27").Select
ActiveSheet.Paste

 

[Korhan Ayhan]

Selamlar,

Lütfen sorularınızı net olarak sorun. Bizleri sürekli önerdiğimiz kodları güncellemek zorunda bırakıyorsunuz. Bu da zaman kaybına yol açıyor.

 

[clodj]

24 mesajım diğer sizlerin yardım etmiş olduğunuz cevaplarla ve kodlarla ilintili değildi. sadece 23 nolu vermiş olduğunuz koda benzediği için (If formülasyonu) ve aynı dosyada kullanacağım için sormuştum. Yeri yanlış oldu sanırım.
kusura bakmayın

 

[clodj]

Sorumu yanlış sordum. sizin göndermiş olduğunuz 23 nolu soruya benzediği için (If fonksiyonu) ve aynı dosyada kullandığım sormuştum. yeri yanlış oldu kusura bakmayın yeni konu açmalıyım.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki şekilde kullanabilirsiniz.

Option Explicit
 
Sub KOŞULLU_KOPYALA()
    If Range("F25") = "Elle" Then
        Range("A18:A23,C18:C23,I18:I23").Copy Sheets("Boya Değişim").Range("F27")
    ElseIf Range("F25") = "Otomatik" Then
        Range("A18:A23,C18:C23,H18:H23").Copy Sheets("Boya Değişim").Range("F27")
    End If
End Sub

 

[clodj]

Sorum çözümlenmiştir. elinize sağlık.
teşekkürler

 

[usubaykan]

Sayın usubaykan, Sayın Korhan Ayhan ve Sayın kuvari
Yardımlarınız için çok teşekkür ederim.
İyi çalışmalar

Zor oldu ama Rica ederim.