• DİKKAT

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

verilerimi tek dosyaya aktarma

  • Konbuyu başlatan Konbuyu başlatan saroz
  • Başlangıç tarihi Başlangıç tarihi
Katılım
3 Aralık 2007
Mesajlar
43
Excel Vers. ve Dili
Office XP Professional
Arkadaşlar ayrı ayrı sayfalarda bulunan senetlerimin tek dosyaya makro olarak veri aktarılmasını istiyorum. Gerekli açıklamaları ekli dosyaya yazdım. Yardım edecekler için şimdiden teşekkürler.
 

Ekli dosyalar

Merhaba,

Module kopyalayarak çalıştırın. Yalnız tarih sütununa hangi verilerin geleceğini anlayamadım bu kısmı hücre adresi ile detaylı açıklarsanız sevinirim..

Kod:
Option Explicit
 
Sub Birlestir()
Dim Satir As Long, Adet As Long, SayfaSonSat As Long
Dim Sayfa As Integer, SayiSat As Long
Dim s1 As Worksheet
Set s1 = Sheets("VERİ DEPOSU")
Application.ScreenUpdating = False
s1.Select
Satir = [B65536].End(3).Row + 1
For Sayfa = 1 To Sheets.Count
    If Sheets(Sayfa).Name <> "VERİ DEPOSU" Then
        SayfaSonSat = Sheets(Sayfa).[B65536].End(3).Row
        If SayfaSonSat > 3 Then
            Adet = SayfaSonSat - 3
            Satir = [B65536].End(3).Row + 1
            Sheets(Sayfa).Range("A4:E" & SayfaSonSat).Copy Range("A" & Satir)
            Range("F" & Satir & ":F" & Satir + Adet - 1) = Sheets(Sayfa).[B2]
            Range("G" & Satir & ":G" & Satir + Adet - 1) = Sheets(Sayfa).[A1]
        End If
    End If
Next Sayfa
SayiSat = s1.[B65536].End(3).Row
s1.Range("A3:A" & SayiSat).ClearContents
s1.Range("A3") = 1: s1.Range("A" & SayiSat) = SayiSat - 2
s1.Range("A3:A" & SayiSat).DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
Application.ScreenUpdating = True
MsgBox "Birleştirme Gerçekleştirildi...", vbInformation, "[URL="http://www.excel.web.tr"]www.excel.web.tr[/URL]"
End Sub


.
 
Ömer bey söz konusu modülü kopyalayarak çalıştırdım. Ancak formülde bir hata var sanırım.

İlk veri aktarımı doğru yapıyor ama ikincide veriler birincinin üstüne yazıyor eski veriler siliniyor.

Tarih sütununa hangi verilerin geleceğini EK dosyada açıklamaya çalıştım. Birde senet türü sutunu içinde tarih verisi gibi aktarma yapılabilirse istediğim gibi olacak.

İlgin için teşekkür ederim.
 

Ekli dosyalar

Ömer bey söz konusu modülü kopyalayarak çalıştırdım. Ancak formülde bir hata var sanırım.

İlk veri aktarımı doğru yapıyor ama ikincide veriler birincinin üstüne yazıyor eski veriler siliniyor.

Tarih sütununa hangi verilerin geleceğini EK dosyada açıklamaya çalıştım. Birde senet türü sutunu içinde tarih verisi gibi aktarma yapılabilirse istediğim gibi olacak.

İlgin için teşekkür ederim.
 
#2 nolu mesajı güncelledim. Tekrar deneyiniz..

.
 
Ömer bey son yaptığınız modülde 2 adet problem var sanırım.

Gönderdiğim Ek dosyada problemi görebilirsiniz.

Bu problemlerde halledilirse oldu diyebiliriz.
 

Ekli dosyalar

Sıra numarasını anladım, fakat diğer istediğinizi anlayamadım. İşlem yapılıp yapılmadığını nerden anlayacağız. Sorularınızı açıklarken detaya inerseniz sevinirim. Hatta eklediğiniz dosyada manuel olarak olması gereken değerleri girerek açıklamaya özen gösteriniz..

.
 
Ömer bey gerekli açıklamaları detaylı yazmaya çalıştım. Ek dosyada bulabilirsiniz.
 

Ekli dosyalar

Diyelimki Posta sayfasındasınız verileri aktar dediniz aktardı, sonra Aps sayfasına geçip verileri aktar dediğinizde daha önce aktarılan Posta sayfası verileri silinip sadece Aps lermi aktarılmış olacak yoksa Aps den aktarılanlar Posta sayfasından gelenlerin devamına mı aktarılacak.

.
 
Evet Ömer bey posta sayfasından gelenlerin devamında aps sayfası aktarılacak veri silinmesi olmayacak. Sürekli veriler alt alta eklenmiş olacak.
 
Bu şekilde deneyin..

Kod:
Option Explicit
 
Sub Birlestir()
Dim VeriSonSat As Long, SayfaSonSat As Long, SayiSat As Long, s1 As Worksheet
 
Application.ScreenUpdating = False
Set s1 = Sheets("VERİ DEPOSU")
VeriSonSat = s1.[B65536].End(3).Row + 1
SayfaSonSat = ActiveSheet.[B65536].End(3).Row
 
If ActiveSheet.Name = "VERİ DEPOSU" Then Exit Sub
If [B4] = "" Then Exit Sub
 
Range("B4:E" & SayfaSonSat).Copy s1.Range("B" & VeriSonSat)
s1.Range("F" & VeriSonSat & ":F" & VeriSonSat + SayfaSonSat - 4) = Range("B2")
s1.Range("G" & VeriSonSat & ":G" & VeriSonSat + SayfaSonSat - 4) = Range("A1")
 
SayiSat = s1.[B65536].End(3).Row
s1.Range("A3:A" & SayiSat).ClearContents
s1.Range("A3") = 1
s1.Range("A" & SayiSat) = VeriSonSat - 1
s1.Range("A3:A" & SayiSat).DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
 
Application.ScreenUpdating = True 
End Sub

.
 
Evet Ömer bey posta sayfasından gelenlerin devamında aps sayfası aktarılacak veri silinmesi olmayacak. Sürekli veriler alt alta eklenmiş olacak.
 

Ekli dosyalar

Verdiğim kodlar istediklerinizi yapıyor. İlk verdiğim kod tüm sayfadaki bilgileri veri sayfasında silmeden alt alta yazar. İkinci kod sadece çalıştığınız sayada kodu çalıştırınca o sayfadaki verileri silmeden veri sayfasına aktarır. Hangisi işinize yaraıyorsa onu kullanırsınız.

İyi çalışmalar..

.
 
Ömer bey her iki kodda işime yarayacak. Ancak İlk verdiğiniz kodda VERİ DEPOSU sayfası "A" sutunu otomatik olarak sıralansa çok iyi olacak. İkinci kodda yaptığınız gibi.
 
$2 nolu mesajı güncelledim,tekrar inceleyiniz..

.
 
Ömer bey size bayağı zahmet verdim.

Elinize sağlık.

Çok güzel olmuş.

İşinizde başarılar dilerim.
 
Geri
Üst