Kapalı dosyalardaki tanımlanmış alanlardaki verileri alma

[Erdinç FIRTINA]

Değerli forum üyeleri,

adları değişik olan kapalı durumdaki dosyaların, aynı adlı sayfalarındaki (sayfa adı "2") f9 - g22 arası hücrelerinde veriler var. Söz konusu aynı klasör içindeki kapalı dosyalarda, alanı tanımlı bu verileri (dolu satırları alacak şekilde) tanımlanan dosyaya yani kodların yer alacağı bu dosyada tanımlanan bir alana almak istiyorum. örneğin: Bu dosyada alınacak yer c2:dson gibi.

örnek dosyaların yer aldığı klasör ektedir.

Yardımlarınız için şimdiden teşekkürler !!!

 

[Ömer BARAN]

Belgelerin tümü açıkken, verilerin geleceği belgede ilgili hücreye;

='Dosya Yolu\[Dosya Adı]Sayfa Adı!'F9
gibi formül uygulayıp dosyayı kaydederek kapatırsanız, veriyi aldığınız belgede değişiklik olduktan sonra, verileri getirdiğiniz dosyayı açtığınızda, açılışta "Güncelleme" ile ilgili soru karşınıza çıkacaktır, bu soruya olumlu cevap vermeniz yeterli.

Yani bildiğimiz sayfalar arası hücre atıflarından farkı yok.

Kıdemli bir üyesiniz, sorunuz biraz şaşırttı aslında.

Ya da ben sorunuzu yanlış anladım.

İyi günler dilerim.

 

[Erdinç FIRTINA]

Sayın omer.baran,

Öncelikle ilgilendiğiniz için çok teşekkür ederim. Bir klasör içinde kapalı durumda bulunan bir çok kapalı dosyadaki belirlenen alandan veri çekmek istediğim için makro ile yapmak istiyorum. Aslında Sayın evrengizlen'in yapmış olduğu makro örneğim var. Bu makroda, belirtilen sayfaların tamamındaki tanımlanan sütunlardaki verileri alıyor. Benim burada yapmak istediğim değişiklik ise, sadece f9-f22 gibi hücre sınırı koymak. Bunun nedeni de almak istediğim sayfaların belirlenen aralığında kullanmadığım veriler var. Örneğin f22 den sonra da bir çok veri var. Dolayısıyla aktardığımda bu verileri de alt alta alıyor. Eğer bunu belirlenen alan ile (örneğin f9-f22) sınırlayabilirsem kullanmayacağım verileri aktarmayacak.

Yardımlarınız için şimdiden çok teşekkür ederim.
Sayın evren gizlen'in düzenlediği makrolar

Sub aktar59()
Dim sat1 As Long, i As Long, sut As Byte, yol As String
Dim dosya As String, sat2 As Long, sh As Worksheet
Application.ScreenUpdating = False
sat1 = 2
yol = ThisWorkbook.Path & "\DOSYALAR\" 'dosyalar klasörün adı
With Sheets("Sayfa1") 'verilerin alınacağı sayfa adı
.Range("A2:L" & Rows.Count).ClearContents
dosya = Dir(yol & "*.xls")
Do While dosya <> ""
If Workbooks.Open(yol & dosya).ReadOnly = True Then Workbooks(dosya).Close False
Set sh = ActiveWorkbook.Sheets("Sayfa1") 'verilerin alın acağı dosyada ki sayfa adı
sat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
If sat2 > 1 Then
sh.Range("A1:L" & sat2).Copy
.Range("A" & sat1).PasteSpecial
Application.CutCopyMode = False
Set sh = Nothing
End If
dosya = Dir
ActiveWorkbook.Close False
sat1 = .Cells(Rows.Count, "A").End(xlUp).Row + 1
Loop
End With
Application.ScreenUpdating = True
MsgBox "işlem tamamlandı." & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[Ömer BARAN]

Sayın omer.baran,

Öncelikle ilgilendiğiniz için çok teşekkür ederim. Bir klasör içinde kapalı durumda bulunan bir çok kapalı dosyadaki belirlenen alandan veri çekmek istediğim için makro ile yapmak istiyorum. Aslında Sayın evrengizlen'in yapmış olduğu makro örneğim var. Bu makroda, belirtilen sayfaların tamamındaki tanımlanan sütunlardaki verileri alıyor. Benim burada yapmak istediğim değişiklik ise, sadece f9-f22 gibi hücre sınırı koymak. ......................

Sayın evren gizlen'in düzenlediği makrolar

Sub aktar59()
.......................
.Range("A2:L" & Rows.Count).ClearContents
...........................
sat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
If sat2 > 1 Then
sh.Range("A1:L" & sat2).Copy
.Range("A" & sat1).PasteSpecial
Application.CutCopyMode = False
........................
End Sub

Yukarıdaki kırmızı olan satırda düzeltme yaparsanız sanırım istediğiniz olacaktır.
Çünkü verinin alınma alanı ve yazılacağı alan tanımlamaları kod'un bu satırlarında gibi görünüyor.

İyi günler dilerim.

 

[Erdinç FIRTINA]

Sayın omer.baran,

Herşey için çok teşekkür ederim ama hata veriyor. Yapılacak bir şey yoksa demekki olmuyordur. Tekrardan çok teşekkürler !!!

 

[muygun]

Merhaba;
Kullandığınız Evren bey'in kodlarında aşağıdaki gibi bir değişiklik sanırım işinizi görür.
İyi çalışmalar.

Sub aktar59()
Dim sat1 As Long, i As Long, sut As Byte, yol As String
Dim dosya As String, sat2 As Long, sh As Worksheet
Application.ScreenUpdating = False
sat1 = 9
yol = ThisWorkbook.Path & "\DOSYALAR\" 'dosyalar klasörün adı
With Sheets("2") 'verilerin alınacağı sayfa adı (bu dosyada)
.Range("F9:G" & Rows.Count).ClearContents
dosya = Dir(yol & "*.xls")
Do While dosya <> ""
If Workbooks.Open(yol & dosya).ReadOnly = True Then Workbooks(dosya).Close False
Set sh = ActiveWorkbook.Sheets("2") 'verilerin alınacağı dosyada ki sayfa adları (kapalı dosyalarda)
sat2 = sh.Cells(Rows.Count, "F").End(xlUp).Row
If sat2 >= 9 Then
sh.Range("F9:G22").Copy
.Range("F" & sat1).PasteSpecial
Application.CutCopyMode = False
Set sh = Nothing
End If
dosya = Dir
ActiveWorkbook.Close False
sat1 = .Cells(Rows.Count, "F").End(xlUp).Row + 1
Loop
End With
Application.ScreenUpdating = True
MsgBox "işlem tamamlandı." & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[Erdinç FIRTINA]

Sayın muygun,
çok çok teşekkür ederim.