Excel Şablonuna yazılan verileri sağ tarafa otomatik olarak yazılması hk.

[link_me]

Merhabalar,
elimde bu şekilde bir şablon var ben bu bilgileri girip tamam dedikten sonra otomatik olarak aynı sayfada sağ tarafa herhangi bir yere bu bilgileri sürekli nasıl kayıt edebilirim yardımcı olabilir misiniz?

MÜŞTERİ BİLGİLERİ

MAKBUZ NO

BRUT AĞIRLIK

YABANCI MADDE

FİRE SONRASI KAĞIT

RUTUBET ORANI

 

[Muzaffer Ali]

Merhaba.
Örnek bir dosya üzerinde göstererek sorarsanız daha anlaşılır olur.
Sorudan bir şey anlaşılmıyor.

 

[link_me]

bilgileri girdikten sonra a18 hücresinde aktar tuşuna basınca e1 ile t1 arasına hepsinin otomatik olarak yazılmasını nasıl sağlayabilirim.
Örnek Dosya Ektedir.

İndir şABLON xlsx

Dosyayı indir şABLON xlsx

dosya.co

 

[Muzaffer Ali]

Butona aşağıdaki kodu uygulayabilirsiniz.

Sub Aktar()
    Dim SiraNo As Long
    SiraNo = Cells(Rows.Count, "E").End(xlUp).Row
    Range("B1:B16").Copy
    Cells(SiraNo + 1, "D") = SiraNo
    Cells(SiraNo + 1, "E").PasteSpecial Paste:=xlPasteValues, Transpose:=True
End Sub

 

[link_me]

teşekkür ederim. fakat şöyle bir sıkıntım var şablonumda 5-7-11 satırlarım gizli,
otomatik kayıt yaparken burasıda gizli oluyor bunu nasıl çözebilirim.

 

[Muzaffer Ali]

Gizli satırlar ya görünür yapmalısınız yada yeni bir sayfa ekleyip kaydı o sayfaya yapabilirsiniz.
Sayfa2 adında yeni bir sayfa ekleyip A1 den itibaren başlıkları ekleyin.
Aşağıdaki kodu Sayfa1'in kod kısmına kopyalayıp çalıştırın.

Sub Aktar()
    Dim SiraNo As Long
    Range("B1:B16").Copy
    With Worksheets("Sayfa2")
        SiraNo = .Cells(Rows.Count, "A").End(xlUp).Row
        .Cells(SiraNo + 1, "A") = SiraNo
        .Cells(SiraNo + 1, "B").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    End With
End Sub

 

[Biolightant]

Merhaba,
Alternatif Kodlar

Sub Makro1()
    ' verilerin bulunduğu hücreleri seçelim
    Range("B1:B16").Select
    
    ' verileri kopyalayıp hafızada tutalım
    Selection.Copy
    
    Dim cell As Range
    ' Sıra No hücresini seç
    ActiveSheet.Range("D1").Select
    
    ' ilk kez veri girilecekse Sıra No = 1
    If ActiveSheet.Range("D2").Value = "" Then
        ActiveSheet.Range("D2").Value = 1
    Else
        ' Ctrl + AşağıOk la gidilen hücre
        Set cell = Selection.End(xlDown)
 
        ' Gizli hücreleri atlamak için döngü
        Do
            Set cell = cell.Offset(1, 0) ' bir altındaki hücre
        Loop While cell.Rows.Hidden ' gizli olmayan hücreyi bulana kadar devam
        
        ' Gizli olmayan hücreyi bulduk Sıra No veriyoruz
        cell.Value = Selection.End(xlDown).Value + 1
    End If

    ' Sıra No su verdiğimiz hücreyi seçiyoruz
    ' D1 hücresinden en son değeri olan hücreyi seçiyoruz
    Selection.End(xlDown).Select

    ' 1 sütün sağında ki hücreyi seçiyoruz ( veriler aktarılacak )
    ActiveCell.Offset(0, 1).Select
    
    ' hafızada ki ( Copy ) deki verileri
    ' özel yapıştır... -> işlemi tersine çevir
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    
    ' 1 sütün solunda ki hücreyi seçiyoruz ( No yazılı yer )
    ActiveCell.Offset(0, -1).Select
    
     ' Copy den çık ( hafızayı temizle )
    Application.CutCopyMode = False
    
End Sub

 

[link_me]

çok çok teşekkür ederim ,son olarak başka bir dosya yüklüyorum .
veriler alt alta olmadığı için mantığını bilemedim bu dosyaya uyarlayamadım boyalı olan verileri nasıl kaydet diyince sayfa2 ye kopyalabilirim acaba bu konuda yardımcı olabilir misiniz?

İndir Dökme Excel 20231 xlsm

Dosyayı indir Dökme Excel 20231 xlsm

dosya.co

 

[Muzaffer Ali]

Kodlar, verileri yazdığınız sayfanın kod kısmında olmalı, yanlış sayfaya kopyalamışsınız.
Aşağıdaki kodu Sayfa1'in kod kısmına kopyalayın.

Sub Aktar()
    Dim SiraNo As Long
    With Worksheets("Sayfa2")
        SiraNo = .Cells(Rows.Count, "A").End(xlUp).Row
        .Cells(SiraNo + 1, "A") = SiraNo
        Range("B13:E13").Copy
        .Cells(SiraNo + 1, "B").PasteSpecial Paste:=xlPasteValues
        Range("F7:H7").Copy
        .Cells(SiraNo + 1, "F").PasteSpecial Paste:=xlPasteValues
    End With
End Sub

Bundan sonra örnek dosya hazırlarken gerçek dosyanızdan farklı yapıda bir dosya hazırlamayın. Gerçek dosyanızı paylaşın.
Eğer gerçek dosyanızda görmemizi istemediğiniz bilgiler varsa o bilgileri örnek bilgilerle değiştirebilirsiniz.
Böyle yaparsanız aynı soruya iki kere cevap aramak zorunda kalmamış olursunuz. Bir tek cevap yeterli olmuş olur.

Kolay gelsin.