Çözüldü Başka bir *.xls dosyasının son sayfasından veri almak?

[harunyurts]

Merhaba,

Kurumsal bir firmada çalışıyorum ve tablolarla çok haşır neşirim,
Sürekli olarak veri takibi yaptığım bir *.xls dosyasının bir bölümü var (mesela A1:M50 aralığı) ve o dosyaya
her gün yeni sayfalar farklı bir isimde açılma durumu söz konusu.
Ben masaüstüme bir dosya.xls açıp her zaman en son sayfaya girilen A1:M50 aralığındaki verileri görmek istiyorum.
Forumda araştırdım buna yakın bir şey bulamadım ve bir formül kombinasyonu da kuramadım.

Yardımcı olur musunuz ? İyi çalışmalar.

 

[tamer42]

Merhaba,

Kurumsal bir firmada çalışıyorum ve tablolarla çok haşır neşirim,
Sürekli olarak veri takibi yaptığım bir *.xls dosyasının bir bölümü var (mesela A1:M50 aralığı) ve o dosyaya
her gün yeni sayfalar farklı bir isimde açılma durumu söz konusu.
Ben masaüstüme bir dosya.xls açıp her zaman en son sayfaya girilen A1:M50 aralığındaki verileri görmek istiyorum.
Forumda araştırdım buna yakın bir şey bulamadım ve bir formül kombinasyonu da kuramadım.

Yardımcı olur musunuz ? İyi çalışmalar.

Aşağıdaki kodu deneyebilirsiniz

    Dim WB1 As Workbook
    Dim WB2 As Workbook
    Dim ws As Worksheet
    Dim s As Byte
    Dim Rng As Range
    
    Set WB1 = ThisWorkbook
    Set WB2 = Workbooks(".......... .xlsx")
    ' Diger dosyanın adını buraya yazın . . .
    Set ws = WB1.ActiveSheet
    ws.Cells.Clear
    
    s = WB2.Worksheets.Count
   
    Set Rng = WB2.Worksheets(s - 1).Range("A1:M50")
    
    Rng.Copy
    
    ws.Activate
    ws.Paste

Application.CutCopyMode = False

 

[harunyurts]

Hocam bu kodlardan anlamam ama çalıştıramadım..

 

[tamer42]

Hocam bu kodlardan anlamam ama çalıştıramadım..

Sadece Dosya adını yazın,
"AYLIK ÜRETİM LT HESAPLAMA.xlsx"

 

[harunyurts]

Sadece Dosya adını yazın,
"AYLIK ÜRETİM LT HESAPLAMA.xlsx"

Hocam hiç bir tepki vermedi. :/
Masaüstündeki dosyalardan birinin adını da yazdım olmadı. Yada ben bir yerde yanlış yapıyorum.

 

[tamer42]

Hocam hiç bir tepki vermedi. :/
Masaüstündeki dosyalardan birinin adını da yazdım olmadı. Yada ben bir yerde yanlış yapıyorum.

Ekran görüntüsünü paylaşır mısınız

 

[harunyurts]

Ekran görüntüsünü paylaşır mısınız

Pek anlamam VBA dan ama Module de ekledim olmadı. Masaüstündeki vardiya dosyasını yazdım, hatta acaba dosyayı açmam mı gerekiyor diye vardiya.xlsx dosyasını da açtım yine olmadı.
Bir video ekleyerek anlatma şansınız varmı?

 

[tamer42]

bir de bu dosyanın açık olması gerekiyor.

Bir hata göremedim, Dosyanızın uzantısı "xlsx" midir?

 

[Korhan Ayhan]

Merhaba,

Şöyle bir eksiklik var.

Kodun başlığı ve bitiş satırı yok. Bunu ekleyip denerseniz sorun büyük ihtimalle düzelecektir.

Sub Aktar()
   'Önerilen kodlar...
   'Önerilen kodlar...
   'Önerilen kodlar...
End Sub

 

[harunyurts]

bir de bu dosyanın açık olması gerekiyor.

Bir hata göremedim, Dosyanızın uzantısı "xlsx" midir?

Evet uzantısı .xlsx . Dosya sürekli açık olursa başka biri kayıt yapamayacak.
O yüzden kodu biraz değiştirdim. Çalışıyor fakat sondan bir önceki sayfayı kopyalıyor

Sub Aktar()
Dim WB1 As Workbook
    Dim WB2 As Workbook
    Dim ws As Worksheet
    Dim s As Byte
    Dim Rng As Range
   
    Set WB1 = ThisWorkbook
    Set WB2 = Workbooks.Open(ThisWorkbook.Path & "\vardiya.xlsx")
    ' Buraya dosya yolu yazınca Dosya bulunamadı hatası veriyor
    Set ws = WB1.ActiveSheet
    ws.Cells.Clear
   
    s = WB2.Worksheets.Count
 
    Set Rng = WB2.Worksheets(s - 1).Range("A1:M50")
   
    Rng.Copy
   
    ws.Activate
    ws.Paste
    WB2.Close SaveChanges = False
Application.CutCopyMode = False
End Sub

Merhaba,

Şöyle bir eksiklik var.

Kodun başlığı ve bitiş satırı yok. Bunu ekleyip denerseniz sorun büyük ihtimalle düzelecektir.

Sub Aktar()
   'Önerilen kodlar...
   'Önerilen kodlar...
   'Önerilen kodlar...
End Sub

Bu şekilde çalıştırdım fakat son sayfayı değil de sondan bir önceki sayfayı kopyalıyor.

 

[tamer42]

Evet uzantısı .xlsx . Dosya sürekli açık olursa başka biri kayıt yapamayacak.
O yüzden kodu biraz değiştirdim. Çalışıyor fakat sondan bir önceki sayfayı kopyalıyor

Sub Aktar()
Dim WB1 As Workbook
    Dim WB2 As Workbook
    Dim ws As Worksheet
    Dim s As Byte
    Dim Rng As Range
  
    Set WB1 = ThisWorkbook
    Set WB2 = Workbooks.Open(ThisWorkbook.Path & "\vardiya.xlsx")
    ' Buraya dosya yolu yazınca Dosya bulunamadı hatası veriyor
    Set ws = WB1.ActiveSheet
    ws.Cells.Clear
  
    s = WB2.Worksheets.Count

    Set Rng = WB2.Worksheets(s - 1).Range("A1:M50")
  
    Rng.Copy
  
    ws.Activate
    ws.Paste
    WB2.Close SaveChanges = False
Application.CutCopyMode = False
End Sub

Bu şekilde çalıştırdım fakat son sayfayı değil de sondan bir önceki sayfayı kopyalıyor.

Set Rng = WB2.Worksheets(s).Range("A1:M50")

olarak dener misiniz

 

[harunyurts]

Set Rng = WB2.Worksheets(s).Range("A1:M50")

olarak dener misiniz

Evet şuanda stabil çalışıyor. Peki kopyalanan hücrelerin boyutlarını bozmadan yapıştırmasını nasıl sağlarım.
Acaba sadece sütunları kopyalasak "A:N" gibi, boyutlarını da taşımış olurmuyuz?

 

[harunyurts]

Evet şuanda stabil çalışıyor. Peki kopyalanan hücrelerin boyutlarını bozmadan yapıştırmasını nasıl sağlarım.
Acaba sadece sütunları kopyalasak "A:N" gibi, boyutlarını da taşımış olurmuyuz?

Evet.
Set Rng = WB2.Worksheets(s).Range("A:N")
Böyle daha iyi oldu. Teşekkür ederim