veri aktarma

[metin_0606]

Giriş sayfasına yazdığım verileri aktar butonuna bastığımda Ana sayfada ilgili bölüme kaydedecek ve yeni veri girişi olduğunda son kaydın altından başlayacak şekilde bir makro lazım değerli arkadaşlar. Yardımcı olursanız sevinirim

 

[Necdet]

Merhaba,

Biraz benden biraz sizden

Private Sub CommandButton1_Click()

    Dim i   As Long, _
        j   As Integer, _
        ShG As Worksheet, _
        ShA As Worksheet
  
    Set ShG = Sheets("GİRİŞ")
    Set ShA = Sheets("ANA SAYFA")
  
    i = ShA.Cells(Rows.Count, "C").End(3).Row
  
    For j = 3 To ShG.Cells(Rows.Count, "A").End(3).Row
        i = i + 1
        ShA.Cells(i, "C") = ShG.Cells(j, "A")
        ShA.Cells(i, "D") = ShG.Cells(j, "B")
        '-------- Devam edin
    Next j
      
    j = ShG.Cells(Rows.Count, "A").End(3).Row
    If j < 3 Then j = 3
    ShG.Range("A3:F" & j).ClearContents
  
    MsgBox "Aktarma Bitmiştir.....", vbInformation, "www.excel.web.tr - Necdet"
  
End Sub

 

[metin_0606]

Merhaba,

Biraz benden biraz sizden

Private Sub CommandButton1_Click()

    Dim i   As Long, _
        j   As Integer, _
        ShG As Worksheet, _
        ShA As Worksheet
   
    Set ShG = Sheets("GİRİŞ")
    Set ShA = Sheets("ANA SAYFA")
   
    i = ShA.Cells(Rows.Count, "C").End(3).Row
   
    For j = 2 To ShG.Cells(Rows.Count, "A").End(3).Row
        i = i + 1
        ShA.Cells(i, "C") = ShG.Cells(j, "A")
        ShA.Cells(i, "D") = ShG.Cells(j, "B")
        '-------- Devam edin
    Next j
       
    j = ShA.Cells(Rows.Count, "A").End(3).Row
    If j < 2 Then j = 2
    ShA.Range("A2:F" & j).ClearContents
   
    MsgBox "Aktarma Bitmiştir.....", vbInformation, "www.excel.web.tr - Necdet"
   
End Sub

[
Denedim maalesef ilgili bölümlere aktarma yapmadı necdet bey

 

[Necdet]

Ben 2 alanı aktardım, gerisini siz tamamlarsınız diye düşündüm.

 

[Necdet]

Kodda küçük bir hata yapmışım Giriş sayfasını silecekken Ana Sayfaya aktardıktan sonra silmişim
Koddlar düzeltilmiştir.
Yeniden deneyiniz.

 

[metin_0606]

hocam denedim bu sefer giriş sayfasının şablon başlıklarını sildi ve ikinci kaydı boşluk yaparak kaydetti. Sana zahmet benim gönderdiğim şablonda kodu deneseniz hata daha iyi anlaşılır diye düşünüyorum

 

[Necdet]

hocam denedim bu sefer giriş sayfasının şablon başlıklarını sildi ve ikinci kaydı boşluk yaparak kaydetti. Sana zahmet benim gönderdiğim şablonda kodu deneseniz hata daha iyi anlaşılır diye düşünüyorum

Ben excelde ilk satır ve ilk sütunun boş olmasını gıcık olduğum için alışkanlık işte, ona göre davranmışım.
Benim mantığımda ilk satır başlıktır.

Dolayısıyla Şablon sayfasını okurken 2. satırdan itibaren okutturuyorum ve silmeyi de ikinci satırdan itibaren yaptırdım.

Siz kodlarda 2 den değil 3. satırdan okutun.
Silmeyi de 3. satırdan itibaren yapın. Sanırım yapabilirsiniz.

For j = 2 To ShG.Cells(Rows.Count, "A").End(3).Row satırında 2'yi 3 yapın.

j = ShG.Cells(Rows.Count, "A").End(3).Row
If j < 2 Then j = 2 satırında 2'leri 3 yapın.
ShG.Range("A2:F" & j).ClearContents --> 3 olacak.


Not : Yinede ilk mesajımdaki kodları düzenledim.

 

[metin_0606]

Ben excelde ilk satır ve ilk sütunun boş olmasını gıcık olduğum için alışkanlık işte, ona göre davranmışım.
Benim mantığımda ilk satır başlıktır.

Dolayısıyla Şablon sayfasını okurken 2. satırdan itibaren okutturuyorum ve silmeyi de ikinci satırdan itibaren yaptırdım.

Siz kodlarda 2 den değil 3. satırdan okutun.
Silmeyi de 3. satırdan itibaren yapın. Sanırım yapabilirsiniz.

For j = 2 To ShG.Cells(Rows.Count, "A").End(3).Row satırında 2'yi 3 yapın.

j = ShG.Cells(Rows.Count, "A").End(3).Row
If j < 2 Then j = 2 satırında 2'leri 3 yapın.
ShG.Range("A2:F" & j).ClearContents --> 3 olacak.


Not : Yinede ilk mesajımdaki kodları düzenledim.

Necdet bey ellerinize sağlık çok teşekkür ederim kod tam istediğim gibi olmuş

 

[Necdet]

Sayın metin_0606 konuyu silmişsiniz.
Gerekçesi de sorunum çözüldü diye. Peki bu konunun başka arkadaşlar tarafından incelenmesi ve onların da yararlanması gerekmez mi?
Her sorunu çözülen mesajları silse, kim ne araştıracaktı, kim neyi inceleyecekti?