• DİKKAT

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

Dosya yolu değişikliği...

S

serkan_sdl

Katılım
18 Ekim 2008
Mesajlar
48
Excel Vers. ve Dili
Microsoft Office Excel 2010
Arkadaşlar merhaba,
Aşağıda ki VBA kodunda "Sayfa1(ANASAYFA TL)" "Sayfa2(Ana Sayfa)" den beslenerek verileri hücrelerine taşımaktadır.

Ancak dosya konumu değişmiştir.

"\\Sunucu\SERKAN\Üretim\Üretim_Yeni.xlsm\Ana Sayfa"

Yardımlarınızı bekliyorum. İyi çalışmalar...




Sub OzetListe()

Dim d, s, a1, a2, deg, i As Long

Set d = CreateObject("Scripting.Dictionary")

Application.ScreenUpdating = False

Sheets("ANASAYFA TL").Select
Range("H32:I" & Rows.Count) = ""

With Sheets("Ana Sayfa")
For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(i, "B") <> "" And .Cells(i, "F") <> "" Then
deg = .Cells(i, "B")
If Not d.exists(deg) Then
s = Array(1, .Cells(i, "F"))
d.Add deg, s
Else
s = d.Item(deg)
s(1) = s(1) & "-" & .Cells(i, "F")
d.Item(deg) = s
End If
End If
Next i

a1 = d.keys: a2 = d.items

For i = 0 To d.Count - 1
Cells(i + 32, "H") = a1(i)
s = a2(i)
Cells(i + 32, "I") = s(1)
Next i
End With

Set d = Nothing
Application.ScreenUpdating = True

End Sub
 
Bu kod'da dosya yoluna başvuru gözükmüyor.
 
Sayfa1 verileri Sayfa2 den alıyor!

idogus' Alıntı:
Bu kod'da dosya yoluna başvuru gözükmüyor.
Genişletmek için tıkla ...


İşte Bende "\\Sunucu\SERKAN\Üretim\Üretim_Yeni.xlsm" adresinde bulunan Üretim_Yeni nin Sayfa1(Ana Sayfa) sından alsın istiyorum verileri

Yardımlarınızı bekliyorum
 
Bu iki dosyayı ekler misiniz_?
Hangi verileri alacak bunu bilmek lazım.
Ağdan bir sunucu ve dosyaya mı bağlanacak.
Ayrıca bu dosya verileri alırken açılsa verileri aldıktan sonra otomatik kapansa işinizi görür mü_?
 
İhsan Tank' Alıntı:
Bu iki dosyayı ekler misiniz_?
Hangi verileri alacak bunu bilmek lazım.
Ağdan bir sunucu ve dosyaya mı bağlanacak.
Ayrıca bu dosya verileri alırken açılsa verileri aldıktan sonra otomatik kapansa işinizi görür mü_?
Genişletmek için tıkla ...

İhsan bey;

Verilerin ANASAYFA daki kırmızı bölgeye,şekilde görüldüğü gibi gelmesini istiyorum.

Veriler kaynağı ise,

\\Sunucu\SERKAN\Üretim\Üretim_Yeni.xlsm dosyasında bulunan Ana sayfa sekmesinde "B" sütununda filtrelenmiş "F" sütundaki verilerdir.

Emeğinize sağlık...
 

Ekli dosyalar

Son düzenleme:
Sanırım yazdığım mesajı okumadınız ben hangi dosyadan hangi dosyaya veri alacağım bunu bilmem lazım ve görmem lazım ki ona göre düzenleme yapayım. Dosya eklemezseniz başka da ileti yazmayacağım siz dosya ekleyene kadar
 
İhsan Tank' Alıntı:
Sanırım yazdığım mesajı okumadınız ben hangi dosyadan hangi dosyaya veri alacağım bunu bilmem lazım ve görmem lazım ki ona göre düzenleme yapayım. Dosya eklemezseniz başka da ileti yazmayacağım siz dosya ekleyene kadar
Genişletmek için tıkla ...

İhsan bey,

Ben dosya ekledim ama, görmediniz sanırım...

İyi çalışmalar...
 
Serkan Bey,

Dosyalar arası herhangi bir bağlantı kodu görünmüyor. Ancak iki sayfayı bir dosyada birleştirirseniz (bir sayfayı taşı kopyala ile) kodunuz çalışacaktır.

Yani iki farklı çalışma kitabının sayfaları bir çalışma kitabında bulunursa kodunuz çalışacaktır.

Vermiş olduğunuz bilgilerde dosyanızın ağda yer değiştirmesinden dolayı çalışmamasını sağlayacak herhangi bir kod bulunmuyor.
 
İlginize teşekkür ederim ama,

Bu dosyalarda ki sekmeleri bir araya getiremem. Yani veri aldığım yer farklı bir yer ve birleştirme şansım yok. Bir şekilde başka kitaptan almak zorundayım.

İyi çalışmalar...
 
İhsan bey,

VBA bilgim olmadığı için eksik bilgi vermiş olabilirim.

Şimde daha açık anlatmaya çalışacağım. Ekte bulunan excel dosyasında 2 sekme var
1- ANA SAYFA TL (Sayfa1)
2- Ana Sayfa (Sayfa4)

1- Sayfa1 e yazılan makro ile excel dosyasının kırmızı bölgesine filitrelenmiş bilgiler geliyor. Yani mesala Kısmet Çanta da 19049 - 19050 modellerinin olduğunu anlıyoruz. Bu verileri yanda ki sekmeden yani Sayfa4 den alıyor.

Benim sorunlarım şunlar;

1- Ben ANA SAYFA TL (Sayfa1) in kırmızı bölgesine gelen verilerin
\\Sunucu\SERKAN\Üretim\ adresinda bulunan "Üretim_Yeni.xlsm" dosyasının içerisinde ki "Ana Sayfa(Sayfa4)" sekmesinden getirsin istiyorum. Çünkü bu sekmeler aslında farklı belgelerin içerikleri.

2- Bu işlemin otomatik olarak güncellenmesini istiyorum..

Saygılar
 

Ekli dosyalar

Serkan Bey,

bu kodlar ile farklı iki dosyadaki verilerin transferi söz konusu olamaz. Bu sayfalar daha önce aynı kitaptaydı biz bunları ayırdık diyorsanız ve bu ayrı iki dosyadan veri transferi için verdiğiniz kodu adapte etmemizi istiyorsanız ona göre çalışalım.
 
İki farklı dosya...

Sn. İdoğuş;

Evet bir önceki mesajımda daha net anlattığımı düşünüyorum.Orada eklediğim dosya da kod düzgün çalışıyor ancak benim ben bu iki sekmeyi ayırmak durumundayım. Sayfa4 başka bir belgenin parçası...

Emeğinize Sağlık...
 
serkan_sdl' Alıntı:
Sn. İdoğuş;

Evet bir önceki mesajımda daha net anlattığımı düşünüyorum.Orada eklediğim dosya da kod düzgün çalışıyor ancak benim ben bu iki sekmeyi ayırmak durumundayım. Sayfa4 başka bir belgenin parçası...

Emeğinize Sağlık...
Genişletmek için tıkla ...

Önceki mesajı sayfayı yenilemediğim için görmemişim evet net anlaşılıyor. Şimdi İhsan Bey konuyu Çözecektir. Sanırım ağdaki dosyanın açılmasıyla ilgili bir sıkıntı yoktur. (Bu soruyu İhsan bey soracaktır çünkü :) )
 
İnşallah...

Bu gün İhsan bey i epey kızdırdım sanırım. İnşallah çözer. Bende bu iş saplantı oldu çünkü...

İyi çalışmalar...
 
İhsan Bey,

Yardımlarınızı bekliyorum. Bu işi bitirmem lazım. Ne olur yardımlarını esirgemeyin!

İyi çalışmalar
 
serkan_sdl' Alıntı:
İhsan Bey,

Yardımlarınızı bekliyorum. Bu işi bitirmem lazım. Ne olur yardımlarını esirgemeyin!

İyi çalışmalar
Genişletmek için tıkla ...

Müsait oldukça yardımcı olmaya çalışıyorum
Anasayfa kitabınızda boş bir module oluşturun ve kopyalayın
Kod: 
Option Explicit
Sub bilgileri_çek_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi, kral, asi
trabzonspor = MsgBox("Verileri Diğer Dosyadan Çekiyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
bordo = ActiveWorkbook.Name
mavi = ActiveSheet.Name
kral = "\\Sunucu\SERKAN\Üretim\"
asi = "Üretim_Yeni.xlsm"
Workbooks.Open (kral & asi)
kral = ActiveSheet.Name
kaplan = 32
Workbooks(bordo).Sheets(mavi).Range("H32:K40").ClearContents
For ts = 4 To Workbooks(asi).Sheets(kral).Cells(Rows.Count, "F") _
.End(xlUp).Row
If WorksheetFunction.CountIf(Workbooks(asi).Sheets(kral).Range("B4:B" & ts), _
Workbooks(asi).Sheets(kral).Cells(ts, "B")) = 1 Then
Workbooks(bordo).Sheets(mavi).Cells(kaplan, "H") = Workbooks(asi).Sheets(kral). _
Cells(ts, "B")
kaplan = kaplan + 1
End If
Next
For ts = 32 To Workbooks(bordo).Sheets(mavi).Cells(Rows.Count, "H") _
.End(xlUp).Row
For kaplan = 4 To Workbooks(asi).Sheets(kral).Cells(Rows.Count, "F") _
.End(xlUp).Row
If Workbooks(asi).Sheets(kral).Cells(kaplan, "B") = Workbooks(bordo). _
Sheets(mavi).Cells(ts, "H") Then
Workbooks(bordo).Sheets(mavi).Cells(ts, "I") = Workbooks(bordo).Sheets(mavi).Cells(ts, "I") & _
Workbooks(asi).Sheets(kral).Cells(kaplan, "F") & " - "
End If
Next
Next
Workbooks(asi).Save
Workbooks(asi).Close
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:sd") & vbLf _
& "Sürede İşlem Tamamlandı", , "Bitiş"
End Sub
 
İhsan bey,

Tek kelimeyle "MUHTEŞEM"siniz....

Ellerinize, kollarınıza sağlık...

Çok çok teşekkür ederim...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst