Soru Açık Excel Dosyasından Kapalı Excel Dosyasına Veri Aktarma..

[TiOr]

Merhaba, Değerli Hocalarım;
Elimde "veri giriş 1" ve "veri giriş 2" isimli 2 adet dosyam var.
Veri giriş 1 dosyasına manuel girilen verilerin totallerini veri giriş 2 dosyasına nasıl dağıtırım kısmında desteğinize ihtiyacım var.
Veri giriş 1 dosyası açık iken veri giriş dosyası 2 kapalı yani açık dosyadan kapalı dosyaya veri aktarımını nasıl gerçekleştirebilirim.

Şöyle izah edeyim personel adet-saat ve harici kargo-stok-günlük işlem adetleri vs.. gibi bilgileri veri giriş 1 dosyasında toplamaktayım. Akabinde operasyon yedeklerini hazırladığım veri giriş 2 dosyama veri giriş 1 dosyasından total işlem adetlerini almakta ve operasyon yedek durumunu raporlamaktayım. Mevcut durumda veri giriş 1 ve 2 dosyalarıma manüel giriş yapmaktayım. Veri giriş 1 dosyasında hazır veri varken ikinci bir kez aynı işlemi diğer dosyaya uygulamakta ayrı bir zaman almaktadır. Bu nedenle bir butona verileri dağıt gibi bir uygulama yapılabilir mi kısmında desteğinize ihtiyacım var.

Not; Veri giriş 1 dosyası her gün içeriği silinerek ve yine her gün veriler işlenmektedir. Fakat veri giriş 2 dosyasına aktarım esnasında en alt satıra işlemesi gerekmektedir çünkü tarih bazlı ilerlemektedir veri giriş 2 dosyası.

Yardımlarınızı talep eder, hayırlı günler dilerim.

 

[Korhan Ayhan]

VERİ GİRİŞ 1 dosyasındaki örnek tablolar alta doğru devam ediyor mu? Eğer devam ediyorsa yapısı nasıl?

 

[TiOr]

VERİ GİRİŞ 1 dosyasındaki örnek tablolar alta doğru devam ediyor mu? Eğer devam ediyorsa yapısı nasıl?

@Korhan Ayhan Hocam Selam,
Veri giriş 1 dosyası alta doğru devam ediyor fakat veri giriş 2 sağa doğru devam ediyor.

Veri giriş 2 dosyası ekran görüntüsü; "sağa doğru devam ediyor"


Veri giriş 2 dosyası ekranı görüntüsü; "sol kısım personel verileri alta doğru devam ediyor" "sağ kısım diğer veriler fakat burada ki verileri de veri giriş 2 dosyasına aktarmaktayım manüel olarak"




Hocam dosyalar büyük ve baya bir veri içermekte.
Kod ve mantık paylaşımı yapabilir iseniz ben bizati dosyalara yedirmeye çalışırım.
Asıl dosyaları paylaşamıyorum.
Teşekkürler..

 

[Korhan Ayhan]

Örnek dosyanıza göre aşağıdaki kod işe yarıyor.

Option Explicit

Sub Veri_Aktar()
    Dim Yol As String, Dosya As String, Veri As Variant
    Dim Zaman As Double, XL_App As Object, K1 As Workbook
    Dim S1 As Worksheet, K2 As Workbook, S2 As Worksheet, Son As Long
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("Sayfa1")
    
    Yol = K1.Path & "\"
    Dosya = Yol & "VERİ GİRİŞ 2.xlsx"
    
    Set K2 = GetObject(Dosya)
    Set S2 = K2.Sheets("Sayfa1")
    
    If S2.Range("A1").Value = Empty Then
        Son = 1
    Else
        Son = S2.Cells(S2.Rows.Count, 1).End(3).Row + 1
    End If
    
    S2.Cells(Son, 1) = S1.Range("A1") & " İŞLEM ADETİ"
    S2.Cells(Son, 2) = S1.Range("C13")
    S2.Cells(Son + 1, 1) = S1.Range("A1") & " PERSONEL SAYISI"
    S2.Cells(Son + 1, 2) = S1.Range("A13")
    
    S2.Cells(Son + 3, 1) = S1.Range("A15") & " İŞLEM ADETİ"
    S2.Cells(Son + 3, 2) = S1.Range("C27")
    S2.Cells(Son + 4, 1) = S1.Range("A15") & " PERSONEL SAYISI"
    S2.Cells(Son + 4, 2) = S1.Range("A27")

    Veri = Application.Transpose(S1.Range("F1:I2").Value)
    S2.Cells(Son + 6, 1).Resize(UBound(Veri), 2) = Veri
    
    S2.Columns.AutoFit
    
    K2.Windows(1).Visible = True
    K2.Windows(1).WindowState = xlMinimized
    K2.Close 1
    
    Set S2 = Nothing
    Set K2 = Nothing
    Set S1 = Nothing
    Set K1 = Nothing

    Application.ScreenUpdating = True
    
    MsgBox "Veri aktarımı tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[TiOr]

@Korhan Ayhan Hocam Selam,
Eline, emeğine, beynine sağlık.
Asıl dosyalara uyarlayıp tekrardan dönüş sağlayacağım.
Çok ama çok teşekkür ederim.
Varol..

 

[TiOr]

@Korhan Ayhan Hocam Selam,
Öncelikle hakkını helal et mübarek ayda uğraştırıyoruz senide.
Paylaştığın kodda hiç bir sıkıntı yok gayet güzel çalışıyor fakat ben dosyalarıma bir türlü uyduramadım.
Ekte örnek dosyaları asıllarına benzer şekilde düzenledim ve paylaştım. Özet anlatım dosyasında ise hangi dosyanın hangi sayfasından ve hangi hücresinden veriyi alarak veri giriş 2 dosyasında aktarımın gerçekleşeceği sütunları belirtim.

Veri Giriş 1 dosyasına girilen veri girişin tamamlanması akabinde veri giriş 2 dosyasına totalleri aktararak bir rapor oluşturmaktayım. Her günün sabahı bu işlemi yapılmakta olup iki iki veri giriş yapmaktayım. Hali hazırda veri giriş 1 dosyasına veri giriliyor ve bir tıkla diğer dosyaya veri aktarımı yapılabiliyor olur ise hemen hemen aynı bir işlemi tekrar yapmamış olacağım.

Şimdiden teşekkür ederim.

Not; Ayhan Hocam veri giriş 2 dosyası bir ortak klasörde bulunmaktadır. Veri giriş 1 ise masa üstümde bulunmaktadır. Veri giriş 2 dosyasının yolu; \\Orh_fileserver\personel\TEM\DEP\MŞT\VeriGiriş2.xlsx gibidir.

Veri giriş 1 dosyası açık dosyadır.
Veri giriş 2 dosyası kapalı dosyadır.

 

[Korhan Ayhan]

Kod ve mantık paylaşımı yapabilir iseniz ben bizati dosyalara yedirmeye çalışırım.

Bunu sanırım siz yazmıştınız..

 

[TiOr]

Bunu sanırım siz yazmıştınız..

Hocam evet haklısınız ama beni aştı... Yedirmeye çalışırım demiştim yapabileceğimi söylememiştim dolayısı ile yapamadım ve desteğinize başvurdum.
Alt alta aktarım yapıyor sağa doğru mantığı çözemedim.
Kusura bakmayın.
Oluru var ise ve imkan vede müsaitlik durumunuz var ise desteğinizi talep ederim.

 

[TiOr]

@Korhan Ayhan Hocam Günaydın,
O kadar ifademin arasından bir ifademi tiye almanız size karşı yapılmış bir saygısızlık olarak mı düşündünüz bilemedim. Herhangi bir saygısız ifadem olmamakla birlikte çok bilmişlikte yapmış değilim. Aksine niyetim halisti sizleri fazla uğraştırmak istemedim ve bu şekilde yapamasamda deneme yanılma yöntemi ile öğrenme gayreti içerisindeyim.

Yanlış bir ifadem oldu ise kusura bakmayın ayrıca yanlış anlaşılsamda özürdilerim.

Hiç yoktan konu hakkında oluru varmı yokmu dönüş sağlar iseniz ona göre uğraş vereyim. Boş yere kürek sallamamış olurum.

Hayırlı günler dilerim...

 

[Korhan Ayhan]

Günaydın,

Oluru elbette var... Amma...

Bu konuda daha önce de defalarca açıklama yapmıştım.

Sizlerin öğrenme niyetlerini anlıyorum fakat bu yöntem doğru bir yöntem değildir. Bu tarz işlemler yapabilmeniz için gelişmiş vba bilgisine hakim olmanız gerekir.

Sizin gibi destek isteyenlerin hemen hemen hepsi sonradan hocam benim asıl dosyada durum şöyleydi şeklinde farklı açıklamalar yaparak tekrar yardım talebinde bulunuyorlar. Takdir edersiniz ki bizlerde iş güç sahibi insanlarız. Zamanlarımız kısıtlı ve değerli. Bu zaman zarfında ne kadar çok kişiye yardımcı olursak o kadar sorunu çözmeye çalışmış oluyoruz. Ben kendi adıma sorulan soruyu iyice anlayıp tek seferde sorunun cevabını vermeye gayret ediyorum. Bunu daha fazla soruya cevap verme arzusu ile yapıyorum.

Size de bu bağlamda bir soru sordum. Çünkü dosyanızın bu kadar basit olamayacağını tahmin ettim.Sizde ben kendim dosyama yedirmeye çalışırım şeklinde yazdığınız için açıkçası ben kendi açımdan bu tarz sorulara çözüldü olarak bakıyorum. Çünkü cevap arayan olarak sizlerin bilgi seviyesini bizler bilemeyiz. Sizlerin ifadeleri bizleri yönlendirmiş oluyor.

Umarım ne demeye çalıştığımı ifade edebilmişimdir.

 

[TiOr]

@Korhan Ayhan Hocam Yine Ben,
Peki bu konuyu aşağıdaki gibi yapmak istesem yardımcı olabilecek misiniz?
Sanırım bu başlık altında sonuca ulaşamayacağız. Farklı bir yol ile sorunu çözüme kavuşturmak istedim;
Aslına farklı bir başlık altında konu açtım ama yine nafile kimse yardımcı olmadı olmuyor

Paylaşmış olduğum kodda kapalı dosyadan veri çekebiliyorum. Kodda belirlenen veri aralığı ve hücre aralığı seçimi yaparak işlev görmektedir.
Veri aralığı kapalı dosyayı içermektedir yani kopyası alınan aralıktır.
Hücre ise açık olan dosyada yapıştırılması istenen hücre aralığıdır.
Burada her bir veri çektiğimde doğal olarak aynı hücrenin üstüne atmaktadır veriyi. Her seferinde hücre aralığını yazmak-belirtmek gerekiyor özetle.

Burada yapmak istediğim hücre aralığı vermeden en son boş satıra veriyi yapıştırmasını nasıl sağlayabilirim?
Yani her veri çektiğimde en son dolu satırın bir altındaki boş satıra atacak çektiği veriyi.

Şimdiden teşekkürler, iyi çalışmalar.

Sub Makro1()

With Application.FileDialog(msoFileDialogOpen)

.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx;*.xlsm;*.xlsa"
.AllowMultiSelect = False
.Show

If .SelectedItems.Count = 0 Then

        MsgBox "LÜTFEN VERİ ÇEKMEK İSTEDİĞİNİZ EXCEL DOSYASINI SEÇİNİZ"
    Exit Sub
    
End If

kopya = InputBox("KOPYALAMAK İSTEDİĞİNİZ VERİ ARALIĞINI YAZINIZ.", Default:="A2:AA2")
yapistir = InputBox("YAPIŞTIRMAK İSTEDİĞİNİZ HÜCREYİ YAZINIZ.", Default:="A2:AA2")

Application.Workbooks.Open .SelectedItems(1)
Set kaynak = Application.ActiveWorkbook

'kaynak.Sheets("Sayfa1").Range(kopya).Copy
kaynak.ActiveSheet.Range(kopya).Copy ThisWorkbook.ActiveSheet.Range(yapistir)
kaynak.Close False


End With

End Sub