Kapalı bir çalışma kitabından başka bir çalışma kitabına veri kopyalama hk.

[serif_007]

Herkese merhabalar;

İş yerinde kullanmakta olduğumuz bir sistemden raporlama yapmaktayız. Rapor dosyalarını sistem excel şeklinde verebiliyor. Fakat değerler çok fazla ve ayrıntılı olduğu için hazırlamak çok uzun zamanımızı alıyor. Şöyle birşey düşünüyorum. Ben sistemden rapor dosyalarını çekeceğim örneğin çektiğim raporun çalışma kitabı adı Kapasite.xls Sayfa adı Kapasite. Kapasite.xls her zaman kapalı. Rapor.xlsm ana rapor çalışma alanım ve bu tabloda da Kapasite sayfası mevcut. Rapor.xlsm dosyasında buton vasıtası ile Kapasite.xls dosyasını açacak Kapasite sayfasındaki a1 ve bk2 sütunları arasındaki verileri kopyalayıp Rapor.xlsm dosyasındaki Kapasite sayfasına değer şeklinde yapıştıracak ve en son işlemi tamamladıktan sonra Kapasite.xls dosyasını kapatacak. İnternette ve forumumuzda biraz araştırdım dosyayı açtım kopyalattım fakat rapor.xlsm dosyasına yapıştıramadım. Bu konuda yardımlarınıza çok fazlasıyla ihtiyacım var. Herkese teşekkür ederim

 

[Haluk]

Örnek dosyalarınızı verin, duruma bakalım....

.

 

[serif_007]

Örnek dosyalarınızı verin, duruma bakalım....

.

Dosyaları ekledim örnek olarak. Yapmak istediğimi anlatabildim mi bilmiyorum ama özetle Kapasite.xlsx'deki verileri Rapor.xlsm'nin Kapasiteler Sayfasına çalışma kitabını açıp kopyala yapıştır yapıp geri kapatacak Rapor.xlsm açık kalacak

 

[Haluk]

Aşağıdaki kodu denersiniz....

Sub Test()
'   Haluk - 15/12/2021
'   sa4truss@gmail.com
    Dim filePath As String, sourceSheet As Worksheet, lastSourceRow As Long, Rng As Range
   
    filePath = ThisWorkbook.Path & "\Kapasite.xlsx"
   
    Application.ScreenUpdating = False
   
    GetObject filePath
    Windows(Dir(filePath)).Visible = False
   
    Set sourceSheet = Workbooks(Dir(filePath)).Sheets("Kapasite")
    lastSourceRow = sourceSheet.Range("A" & Rows.Count).End(xlUp).Row
   
    Set Rng = sourceSheet.Range("A1:B" & lastSourceRow)
   
    Worksheets("Kapasiteler").Range("A1").Resize(Rng.Rows.Count, Rng.Columns.Count).Cells.Value = Rng.Cells.Value
   
    Workbooks(Dir(filePath)).Close SaveChanges:=False
   
    Application.ScreenUpdating = True
End Sub

.

 

[serif_007]

Aşağıdaki kodu denersiniz....

Sub Test()
'   Haluk - 15/12/2021
'   sa4truss@gmail.com
    Dim filePath As String, sourceSheet As Worksheet, lastSourceRow As Long, Rng As Range
  
    filePath = ThisWorkbook.Path & "\Kapasite.xlsx"
  
    Application.ScreenUpdating = False
  
    GetObject filePath
    Windows(Dir(filePath)).Visible = False
  
    Set sourceSheet = Workbooks(Dir(filePath)).Sheets("Kapasite")
    lastSourceRow = sourceSheet.Range("A" & Rows.Count).End(xlUp).Row
  
    Set Rng = sourceSheet.Range("A1:B" & lastSourceRow)
  
    Worksheets("Kapasiteler").Range("A1").Resize(Rng.Rows.Count, Rng.Columns.Count).Cells.Value = Rng.Cells.Value
  
    Workbooks(Dir(filePath)).Close SaveChanges:=False
  
    Application.ScreenUpdating = True
End Sub

.

Haluk bey çok teşekkür ederim tam da istediğim gibi olmuş. Sanırım artık saatlerce uğraşmak yerine 1 dakikamı alacak rapor işi