Soru Girilen veriyi başka bir hücreye otomatik taşıma

[rubens45]

Merhaba;
ekte görebileceğiniz üzere A1 e gireceğim veriyi PC00000097XXXXXXX ile başlıyorsa Fsutunda ki sıradaki boş hücreye atsın istiyorum ancak nasıl yapabileceğimi bilemiyorum. Girdiler sabit yani PC00000097/98/25/23 gibi sayılar ile başlıyor sonrası değişken. A1 hücresine veriyi barkod okuyucu ile okutuyorum.Desteğiniz için şimdiden teşekkürler

 

[Ömer BARAN]

Merhaba.

-- Alt taraftan ilgili sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranında sağdaki boş alana aşağıdaki kod blokunu yapıştırın.
Tablodaki başlık yapınız şayet, örnekteki gibi pc 97 veya pc 127 gibi PC00000097XXXXX veya PC00000127XXXXX gibi eşleşiyorsa
istenilen işlem gerçekleşir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
If WorksheetFunction.CountIf([1:1], Left(Target, 2) & " " & Val(Mid(Target, 3, 8))) = 0 Then Exit Sub
baslik = Left(Target, 2) & " " & Val(Mid(Target, 3, 8))
sut = WorksheetFunction.Match(baslik, [1:1], 0)
sat = Cells(Rows.Count, sut).End(3).Row + 1
Cells(sat, sut) = Target
Target = ""
End Sub

 

[rubens45]

Ömer bey yardımınız için çok teşekkürler ancak çalıştıramadım. Dediklerinizi aynen yaptım. Örnek olarak C1 in adı PC00000097111444, A1 sutununa PC00000097555222 yazdığımda C13 gelmiyor

 

[Ömer BARAN]

Başlıkların tümü yazılmış ve A1 hücresine de ilgili sütunu bulunamayan bir barkod numarası yazarak örnek belgeyi yenilerseniz bakarım.

 

[rubens45]

Ömer bey şuan ekteki dosyada tümü ile başlıklar hazır. Barkodu okuttuğumda bir sonraki okuma işlemi için işaretçi aynı hücrede durması lazım ki daha hızlı yapabileyim bu da sizin kodlarınız ile mümkün mü acaba?

 

[Ömer BARAN]

Merhaba.

Son örnek belgenize göre;
-- alt taraftan Sayfa1'in adına fareyle sağ tıklayıp KOD GÖDÜRTÜLEyi seçin
-- açılan VBA ekranında sağ tarafa aşağıdaki kod blokunu yapıştırın (varsa, aynı yerdeki daha evvel verdiğim kodu silin)
İstenilen sonucun alınması gerekir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Set bul1 = [2:2].Find(Left(Target, 12), Lookat:=xlWhole)
If Not bul1 Is Nothing Then
        sut = bul1.Column: GoTo 10
    Else: Set bul2 = [2:2].Find(Left(Target, 11), Lookat:=xlWhole)
        If Not bul2 Is Nothing Then
            sut = bul2.Column: GoTo 10
        Else: Set bul3 = [2:2].Find(Left(Target, 10), Lookat:=xlWhole)
            If Not bul3 Is Nothing Then
                sut = bul3.Column: GoTo 10
            Else: MsgBox "Okutulan BARKOD sayfada BULUNAMADI !", vbCritical
                Exit Sub: End If: End If: End If
10: Cells(Cells(Rows.Count, sut).End(3).Row + 1, sut) = Target
Target = "": Target.Activate
End Sub

 

[rubens45]

Ömer bey merhaba çok teşekkürler şimdi oldu çok sağolun ancak ikici okutma işleminde işaretliyici a2 ye atlıyor

 

[Ömer BARAN]

Dosya ekte.
.

 

[Ömer BARAN]

Gönderdiğim kod blokunun en sonundaki End Sub satırının hemen üstüne Target.Activate şeklinde bir satır ekleyin.

 

[rubens45]

tamamdır çok teşekkürler