• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

A sütunundaki veriyi B Sütununa Aktarma...

  • Konbuyu başlatan Konbuyu başlatan yegan
  • Başlangıç tarihi Başlangıç tarihi
Y

yegan

Katılım
11 Mart 2005
Mesajlar
57
Excel Vers. ve Dili
2016-TR
Arkadaşlar Ben B sütunundaki boş hücreye hemen onun yanında bulunan A sütunundaki bilgi aktarmak istiyorum.Yani B27 hücresine A27 hücresindeki bilgiyi aktarmak istiyorum.Ve bu bilgileri kalıcı olmalı sonra A sütunun sildiğimde bilgileri kaybolmamalı.Ayrıca B sütunundaki sadece boş olan satırlara bu işlem uygulanmalı.Demek istediğimi tam olarak anlatabilmek için size örnek dosya gönderiyorum.Yardımınız için şimdiden teşekkürler...
 
Modüle ekleyerek çalıştırın.


Kod: 
Sub boşları_yaz()
For i = 1 To 35
If Cells(i, 2) = "" Then
Cells(i, 2).Value = Cells(i, 1).Value
End If
Next
End Sub
 
Selamlar,

Sn. fructose cevabınızı vermiş ama kodu biraz daha kısaltabiliriz.

Kod: 
Sub AKTAR()
    For X = 1 To [A65536].End(3).Row
    If Cells(X, 2) = "" Then Cells(X, 2) = Cells(X, 1)
    Next
End Sub

Ayrıca bu işlemi makro kullanmadan da yapabilirsiniz. Sırasıyla aşağıdaki işlemleri takip ediniz.

1- B sütununu seçin ve F5 tuşuna basın.
2- Özel bölümünden Boşluklar kısmını işaretleyin ve tamam dedikten sonra formül çubuğuna mouse ile tıklayıp =A5 yazıp CTRL+ENTER tuşlarına basın.
3- Daha sonra B sütunu seçili iken kopyala ve değerleri yapıştır deyip işleminizi tamamlayın.
 
Arkadaşlar teşekkür ederim.Cevaplarınızı ben acemiliğimden dolayı uygulayamamış olabilirim.Yapmak istediğimi tam olarak anlatmak için ekte üzerinde çalışma yaptığım dosyalardan birini gönderiyorum.Bu dosyayı benim istediğime göre uyarlayabilirseniz çok sevinirim.Saygılar...
 
Selamlar,

Aşağıdaki şekilde deneyiniz.

Kod: 
Sub AKTAR()
    For X = 1 To [A65536].End(3).Row
    If Cells(X, 4) = "" Then Cells(X, 4) = Cells(X, 3)
    Next
End Sub
 
Çok teşekkür ederim arkadaşlar...Bu sefer başardım ve beni inanılmaz bir yükten kurtardınız.Çok teşekkürler...
 
G,H,I,J sütunundaki verileri K,L,M,N sutunlarına aktarma

Selamlar,

F sütunu boşsa ;
G, sütunundaki veriyi K sütununa
H, sütunundaki veriyi L sütununa
I, sütunundaki veriyi M Sütununa
J, sütunundaki veriyi N sutunlarına aktarmak istiyorum.

Bu aktarımı I sütununun son satırına kadar yapmalı.
 
Selamlar,

Lütfen konuyla ilgili örnek bir dosya eklermisiniz.
 
Veri aktarma

Selamlar,

Ekli dosyada Sheet1 de ki verileri sheet 1015557 haline getirmek istiyorum.

Benim yazdığım kodlar siteden alıntı ve acemice.

ctrl+w ile makroyu çalıştırdığınızda A sütununda boş kalan hücreler olacak.
A sütunu boş ise bir üst satırda A:J sütunlarındaki verileri kopyalayıp boş satırıa A:J arasına yapıştırmak için aşağıdaki makroyu kullanyım dedim. Beceremedim.

"Sub iade_kaynak()
For a = 2 To [I65536].End(3).Row
If Cells(a, "a") = "" Then Cells(a, "a:J") = Cells(a - 1, "a:J")
Next

End Sub"
 
Selamlar,

Kullandığınız kodu aşağıdaki ile değiştirip denermisiniz.

Kod: 
Sub AKTAR()
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("1015557")
    S2.[A3:M65536] = ""
    SATIR = 3
    For X = 8 To S1.[N65536].End(3).Row
    If S1.Cells(X, "B") <> "" Then
    S2.Cells(SATIR, "A") = S1.Cells(X, "B")
    S2.Cells(SATIR, "B") = S1.Cells(X + 1, "C")
    S2.Cells(SATIR, "C") = S1.Cells(X + 1, "D")
    S2.Cells(SATIR, "D") = S1.Cells(X, "E")
    S2.Cells(SATIR, "E") = S1.Cells(X, "G")
    S2.Cells(SATIR, "F") = S1.Cells(X + 1, "I")
    S2.Cells(SATIR, "G") = S1.Cells(X, "L")
    S2.Cells(SATIR, "H") = S1.Cells(X, "M")
    S2.Cells(SATIR, "I") = S1.Cells(X, "N")
    S2.Cells(SATIR, "J") = S1.Cells(X, "O")
    S2.Cells(SATIR, "K") = S1.Cells(X + 1, "L")
    S2.Cells(SATIR, "L") = S1.Cells(X + 1, "M")
    S2.Cells(SATIR, "M") = S1.Cells(X, "N")
    SATIR = SATIR + 1
    End If
    Next
    MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub
 
kod aynı sayfa için çalışmalı

Selamlar,

İlğiniz için teşekkür ederim,

Kodların aynı sayfada çalışması gerekiyor.

Örnek olması amacıyla ben iki sayfalı olarak gönderdim.




COST_CONTROL' Alıntı:
Selamlar,

Kullandığınız kodu aşağıdaki ile değiştirip denermisiniz.

Kod: 
Sub AKTAR()
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("1015557")
    S2.[A3:M65536] = ""
    SATIR = 3
    For X = 8 To S1.[N65536].End(3).Row
    If S1.Cells(X, "B") <> "" Then
    S2.Cells(SATIR, "A") = S1.Cells(X, "B")
    S2.Cells(SATIR, "B") = S1.Cells(X + 1, "C")
    S2.Cells(SATIR, "C") = S1.Cells(X + 1, "D")
    S2.Cells(SATIR, "D") = S1.Cells(X, "E")
    S2.Cells(SATIR, "E") = S1.Cells(X, "G")
    S2.Cells(SATIR, "F") = S1.Cells(X + 1, "I")
    S2.Cells(SATIR, "G") = S1.Cells(X, "L")
    S2.Cells(SATIR, "H") = S1.Cells(X, "M")
    S2.Cells(SATIR, "I") = S1.Cells(X, "N")
    S2.Cells(SATIR, "J") = S1.Cells(X, "O")
    S2.Cells(SATIR, "K") = S1.Cells(X + 1, "L")
    S2.Cells(SATIR, "L") = S1.Cells(X + 1, "M")
    S2.Cells(SATIR, "M") = S1.Cells(X, "N")
    SATIR = SATIR + 1
    End If
    Next
    MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...
 
Selamlar,

Tam olarak test edemedim ama aşağıdaki şekilde denermisiniz.

Kod: 
Sub VERİLERİ_DÜZENLE()
    Set S1 = Sheets("Sheet1")
    S1.[A1] = "NS no."
    S1.[A2] = "Alt"
    S1.[B1] = "ÜY"
    S1.[C1] = "Batch"
    S1.[D1] = "Klm."
    S1.[E1] = "Malzeme"
    S1.[F1] = "Yrtm.trh."
    S1.[G1] = "Tip"
    S1.[G2] = "Tip"
    S1.[H1] = "Kynk.adr."
    S1.[H2] = "Hedef adr."
    S1.[I1] = "   Pln.mkt.(kyn.)"
    S1.[I2] = "  Hedef dp.pl.mkt"
    S1.[J1] = "AÖB"
    S1.[K1] = "Tip"
    S1.[K2] = "Tip"
    S1.[L1] = "Hedef adr."
    S1.[L2] = "İade adr."
    S1.[M1] = "  Hedef dp.pl.mkt"
    S1.[M2] = " Pln.miktar(iade)"
    
    SATIR = 3
    For X = 8 To S1.[N65536].End(3).Row
    If S1.Cells(X, "B") <> "" Then
    S1.Cells(SATIR, "A") = S1.Cells(X, "B")
    S1.Cells(SATIR, "B") = S1.Cells(X + 1, "C")
    S1.Cells(SATIR, "C") = S1.Cells(X + 1, "D")
    S1.Cells(SATIR, "D") = S1.Cells(X, "E")
    S1.Cells(SATIR, "E") = S1.Cells(X, "G")
    S1.Cells(SATIR, "F") = S1.Cells(X + 1, "I")
    S1.Cells(SATIR, "G") = S1.Cells(X, "L")
    S1.Cells(SATIR, "H") = S1.Cells(X, "M")
    S1.Cells(SATIR, "I") = S1.Cells(X, "N")
    S1.Cells(SATIR, "J") = S1.Cells(X, "O")
    S1.Cells(SATIR, "K") = S1.Cells(X + 1, "L")
    S1.Cells(SATIR, "L") = S1.Cells(X + 1, "M")
    S1.Cells(SATIR, "M") = S1.Cells(X, "N")
    SATIR = SATIR + 1
    End If
    Next
    S1.[N:Q] = ""
    SON = S1.[A65536].End(3).Row + 1
    S1.Range(Cells(SON, "A"), Cells(65536, "M")) = ""
    S1.Cells.EntireColumn.AutoFit
    MsgBox "Veri düzenleme işlemi tamamlanmıştır.", vbInformation
End Sub
 
Son düzenleme:
Kodlara ileve yapmak için....

Sayın Cost_Control,
aktarma tuşuna bastıktan sonra, "bilgileri aktarmak istiyormusun" şeklinde Evet-Hayırlı bir mesaj kutusu eklemek istersek, kodlar ne şekilde ve hangi kısma yazılmalıdır. Ufak bir eklenti yapabilir misiniz.?
 
Selamlar,

A&#351;a&#287;&#305;daki &#351;ekilde kullanabilirsiniz.

Kod: 
Sub AKTAR()
    Onay = MsgBox("Bilgileri aktarmak istiyor musunuz ?", vbYesNo + vbExclamation, "ONAY")
    If Onay = vbNo Then Exit Sub
    If Onay = vbYes Then
    'Sizin aktar&#305;m kodlar&#305;n&#305;z...
    End If
    MsgBox "Aktar&#305;m i&#351;lemi tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub
 
benzer bir sorun lütfen yardım

hocam benzer bir sorun bendede var verdiğiniz kodları yazmaya çalıştım daha doğrusu yazdımda uyarlamaya çalıştım ama yapamadım bir bakarmısınız teşekkürler
 
Selamlar,

Örnek dosyanızı inceledim. C ve D sütunlarını birleştirmişsiniz. Bu problem yarattığı için ayırdım. Yaptığım düzenlemeye göre C4 hücresine yeni yılın tarihini yazıp butona basarsanız aktarım işlemi yapılacaktır. Ekte örnek dosyanızda gerekli düzenlemeleri yaptım. İncelermisiniz. Umarım faydası olur.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst