A1 ile A10 arasındaki hücrelere girilen verileri aynı satıra kaydetme.

[saitbeyoglu]

Selam Arkadaşlar.

Forum sayesinde daha önceden geliştirdiğimiz kodu daha kullanışlı hale getirmek istiyorum.

Aşağıdaki kod A1 ile A10 arasına girilen verileri aynı satıra E sütunundan başlayarak sırasıyla ilk boş yere ekliyor.

Benim istediğim eğer mümkünse
A1 ile A10 arasına girilen veriler E ' den başlayarak sırasıyla DA sütununa kadar eklesin.
B1 ile B10 arasına girilen verileri DB ' den başlayarak HA sütununa kadar eklesin.
C1 ile C10 arasına girilen verileri HB ' den başlayarak LA sütununa kadar eklesin.

Mümkünse yardımlarınızı bekliyorum arkadaşlar.
Elimdeki kod.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A1:A10]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    cancel = True
    If Target.Value <> "" Then
        Target.Select
        Application.EnableEvents = False
        sat = Target.Row
        If Cells(sat, 5) = "" Then
            Cells(sat, 5) = Target.Value
            Else
            If Cells(sat, Columns.Count) = Empty Then
                sut = Cells(sat, Columns.Count).End(xlToLeft).Column
                Cells(sat, sut + 1) = Target.Value
            Else
                MsgBox sat & ".Satır doldu.", vbCritical
            End If
        End If
        Target.Value = ""
        Application.EnableEvents = True
    End If
End Sub

 

[saitbeyoglu]

Yukarıda yazdığım formülde

sut = Cells(sat, Columns.Count).End(xlToLeft).Column

bu kod o satırdaki tüm sütunların içinde dolu son sütunu buluyor heralde.
biz bunu belirli aralıktaki sütunların içindeki dolu son hücreyi bulanı nasıl yazarız.
Örneğin tüm sütunu değilde D sütunu ile ZZ sütununa kadar olanları tarasın bunların içindeki veri bulunan son hücreyi bulsun

makro bilgim zayıf bilen arkadaşlardan yardım istiyorum.

 

[ÖmerBey]

Şu şekilde yapabilirsiniz.

sut = Cells(sat,[COLOR="Red"] "ZZ"[/COLOR]).End(xlToLeft).Column

Ama ZZ sütunu dolu olduğunda veya o satırda dolu bir hücre olmadığında problem olacağı için şunun gibi bir kontrol ayarlayabilirsiniz.

If Cells(sat, "ZZ") = "" Then
    sut = Cells(sat, "ZZ").End(xlToLeft).Column
    If sut < 4 Then sut = 4 'Buradaki 4  D sütununun sütun numarası
Else
    MsgBox sat & ".Satır doldu.", vbCritical
End If

 

[saitbeyoglu]

Sayın mucit77
Yardımın için çok teşekkür ederim.
Şimdi aşağıdaki kodla A sütununa girilen verileri E ile Z sütunları arasına kaydedebiliyorum. Aralık dolduğu zaman da satır dolmuştur diye uyarıda veriyor.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A10]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    cancel = True
    If Target.Value <> "" Then
        Target.Select
        Application.EnableEvents = False
        sat = Target.Row
        If Cells(sat, 5) = "" Then
            Cells(sat, 5) = Target.Value
            Else
            If Cells(sat, "Z") = Empty Then
                sut = Cells(sat, "Z").End(xlToLeft).Column
                Cells(sat, sut + 1) = Target.Value
            Else
                MsgBox sat & ". Satır veri giriş yerleri doldu.", vbCritical
            End If
        End If
        Target.Value = ""
        Application.EnableEvents = True
    End If
End Sub

 

[saitbeyoglu]

Şimdi aşağıdaki kodun altına "hedef değer A sütununa girilmişse" şartını nasıl ekleyebiliriz. Yardımlarınızı bekliyorum arkadaşlar.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A10,B1:B10]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    cancel = True
    If Target.Value <> "" Then
        Target.Select
        Application.EnableEvents = False
        sat = Target.Row

bu koddan sonra bir şart eklememiz gerekiyor.
Target.Value eğer A sütununda ise diye sonra kod aynen devam edecek.

 

[saitbeyoglu]

Arkadaşlar sorunu çözdüm. Şimdi aşağıdaki kodla
A1 ile A10 arasındaki hücrelere girilen veriler aynı satırda E ile Z sütunları arasına kaydediliyor. satır dolduğu zaman uyarı veriyor.
B1 ile B10 arasındaki hücrelere girilen veriler aynı satırda AD ile BB sütunları arasına kaydediliyor. satır dolduğu zaman yine uyarı veriyor.

Kod tam istediğim hale geldi yardım eden arkadaşlar ve excell web tr ye candan teşekkür ederim.
Böylece yapmak istediğim depo kontrol programı çok güzel olacak.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A10,B1:B10]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    cancel = True
    If Target.Value <> "" Then
        Target.Select
        Application.EnableEvents = False
        sat = Target.Row
            If Target.Column = "1" Then
                If Cells(sat, 5) = "" Then
                   Cells(sat, 5) = Target.Value
                Else
                    If Cells(sat, "Z") = Empty Then
                        sut = Cells(sat, "Z").End(xlToLeft).Column
                        Cells(sat, sut + 1) = Target.Value
                    Else
                        MsgBox sat & ". Satır veri giriş yerleri doldu.", vbCritical
                    End If
                End If
                    Target.Value = ""
                    Application.EnableEvents = True
            Else
                If Target.Column = "2" Then
                    If Cells(sat, 30) = "" Then
                       Cells(sat, 30) = Target.Value
                    Else
                        If Cells(sat, "BB") = Empty Then
                            sut = Cells(sat, "BB").End(xlToLeft).Column
                            Cells(sat, sut + 1) = Target.Value
                        Else
                            MsgBox sat & ". Satır veri giriş yerleri doldu.", vbCritical
                        End If
                    End If
                        Target.Value = ""
                        Application.EnableEvents = True
                 End If
            End If
    End If
End Sub