verileri sütunları aktar

[iscinar]

Sn. Ömer bey'in büyük katkılarıyla son halini almış olan çalışma kitabımda şimdilik veri aktarma ve İcmal Raporu eksiğim kaldı. Bu konularda yardım edecek arkadaşlara şimdiden çok teşekkür ediyorum.

"D1" sütununa girmiş olduğum tarih ve "D3 ten aşağıya doğru olan miktarları sabit bir sayfanın ( "Gelen " sayfalarından sadece birinin )son boş sütununa veya satırında ilgili malzemenin karşısına
(Hangi sayfayı kullanmamız daha verimli olacaksa o sayfaya) aktarmak istiyorum.

Sütun ve Satır sayfaları alternatif örnek olarak hazırlanmıştır. Birini sileceğim. Benim için önemli olan veri girişini "AnaSayfa" dan yapıp "Yıllık İcmal" sayfasında durumu görmek.

Çalışma kitabının diğer sayfalarında başka raporlar için de kullandığım bu sayfanın renkli hücrelerini kilitliyorum sadece Renklendirilmemiş hücrelere veri girişi yapıyorum.

Örneğin talep hazırlamak için girdiğim veriler geçici olacağı için aktar butonuna basmadan verileri "Gelen" sayfasına aktarmamalı. Bu sayfaya yazdığım rakamların yansımasından raporlar, tutanaklar ve talep formları oluşturuyorum. (D3 ve E3 ten aşağısını temizle butonu da koyabilirsek güzel olur)

Malzemelerin her sayfada sıra numarası aynı. AnaSayfada Sıra numarası 5 olan bir malzemenin bütün sayfalarda sıra numarası 5 tir. Eğer satır numaraları bizim için değer olacaksa diğer sayfalarımı etkilemez.

 

[Ömer]

Merhaba,

Private Sub CommandButton9_Click()
Dim Sg As Worksheet, sat As Long, sut As Integer
Application.ScreenUpdating = False
Set Sg = Sheets("Gelen (Sütun)")
sat = Cells(Rows.Count, "B").End(xlUp).Row
sut = Sg.Cells(1, Columns.Count).End(xlToLeft).Column + 1
    Range("D1").Copy Sg.Cells(1, sut)
    Range("D3:D" & sat).Copy Sg.Cells(2, sut)
        Sg.Range("G1:G" & sat - 1).Copy
        Sg.Cells(1, sut).PasteSpecial xlPasteFormats, xlNone, False, False
        Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Bu şekilde deneyiniz. Sayfa seçmenize gerek yok, çünkü verilerin aktarılacağı sayfa Gelen (Sütun) olarak belirlenmiştir..

Not: Sorularınızı farklı konu başlıklarının devamına değil yeni konu başlığı açarak sormanızı rica ederim..

.

 

[assenucler]

Sayın iscinar ve sayın Ömer;

Günaydın..

Emek ve katkılarınız için teşekkürler..

Sevgi ve saygılar..

 

[iscinar]

Merhaba,

Not: Sorularınızı farklı konu başlıklarının devamına değil yeni konu başlığı açarak sormanızı rica ederim..

.

Öncelikle ilginiz için çok teşekkür ediyorum.

Önceki konu veri aktarma ile ilgili olduğu için o konunun devamına ekledim. Belki soru soruyu, sorular farklı fikirleri doğurur niyetiyle. Kusuruma bakmayın.

Vermiş olduğunuz kodları ekledim. Ayrıca hata ile aktarmaların önüne geçmek için

Private Sub CommandButton9_Click()
[COLOR="Red"]MsgBox "Verileri Aktarmak İstiyormusunuz?", vbYesNo, " "[/COLOR]
Dim Sg As Worksheet, sat As Long, sut As Integer
Application.ScreenUpdating = False
Set Sg = Sheets("Gelen (Sütun)")
sat = Cells(Rows.Count, "B").End(xlUp).Row
sut = Sg.Cells(1, Columns.Count).End(xlToLeft).Column + 1
    Range("D1").Copy Sg.Cells(1, sut)
    Range("D3:D" & sat).Copy Sg.Cells(2, sut)
        Sg.Range("G1:G" & sat - 1).Copy
        Sg.Cells(1, sut).PasteSpecial xlPasteFormats, xlNone, False, False
        Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

MsgBox ekledim fakat Hayır dediğim halde aktarıyor acaba yerinde mi yoksa kodunda mı hata var?

 

[Ömer]

Bu şekilde deneyiniz..

Private Sub CommandButton9_Click()
Dim Sg As Worksheet, sat As Long, sut As Integer, onay As String
Set Sg = Sheets("Gelen (Sütun)")
sat = Cells(Rows.Count, "B").End(xlUp).Row
sut = Sg.Cells(1, Columns.Count).End(xlToLeft).Column + 1
Application.ScreenUpdating = False
onay = MsgBox("Verileri Aktarmak İstiyormusunuz?", vbCritical + vbYesNo, "Dikkat !")
If onay = vbYes Then
    Range("D1").Copy Sg.Cells(1, sut)
    Range("D3:D" & sat).Copy Sg.Cells(2, sut)
    Sg.Range("G1:G" & sat - 1).Copy
    Sg.Cells(1, sut).PasteSpecial xlPasteFormats, xlNone, False, False
    Application.CutCopyMode = False
End If
Application.ScreenUpdating = True
End Sub

.

 

[iscinar]

Teşekkür

Elinize ve emeğinize sağlık. İlginize çok teşekkür ediyorum.